Browse Source

punk::args option grouping, more tclcore docs

master
Julian Noble 2 months ago
parent
commit
0b10aa8cab
  1. 23
      src/modules/punk-0.1.tm
  2. 1448
      src/modules/punk/args-999999.0a1.0.tm
  3. 2
      src/modules/punk/args-buildversion.txt
  4. 1500
      src/modules/punk/args/tclcore-999999.0a1.0.tm
  5. 6
      src/modules/punk/console-999999.0a1.0.tm
  6. 1
      src/modules/punk/lib-999999.0a1.0.tm
  7. 97
      src/modules/punk/ns-999999.0a1.0.tm
  8. 13
      src/modules/punk/zip-999999.0a1.0.tm
  9. 107
      src/modules/shellrun-0.1.1.tm
  10. 14
      src/modules/test/punk/#modpod-args-999999.0a1.0/args-0.1.5_testsuites/args/args.test
  11. 97
      src/modules/test/punk/#modpod-args-999999.0a1.0/args-0.1.5_testsuites/args/synopsis.test
  12. 176
      src/modules/textblock-999999.0a1.0.tm

23
src/modules/punk-0.1.tm

@ -6803,9 +6803,18 @@ namespace eval punk {
punk::args::define { punk::args::define {
@dynamic @dynamic
@id -id ::punk::LOC @id -id ::punk::LOC
@cmd -name punk::LOC -help\ @cmd -name punk::LOC\
-summary\
"Lines Of Code counter"\
-help\
"LOC - lines of code. "LOC - lines of code.
An implementation of a notoriously controversial metric" An implementation of a notoriously controversial metric.
Returns a dict or dictionary-display containing various
counts such as:
'loc' - total lines of code.
'purepunctuationlines' - lines consisting soley of punctuation.
'filecount' - number of files examined."
@opts
-return -default showdict -choices {dict showdict} -return -default showdict -choices {dict showdict}
-dir -default "\uFFFF" -dir -default "\uFFFF"
-exclude_dupfiles -default 1 -type boolean -exclude_dupfiles -default 1 -type boolean
@ -6820,13 +6829,18 @@ namespace eval punk {
} " } "
#we could map away whitespace and use string is punct - but not as flexible? review #we could map away whitespace and use string is punct - but not as flexible? review
-punctchars -default { [list \{ \} \" \\ - _ + = . > , < ' : \; ` ~ ! @ # \$ % ^ & * \[ \] ( ) | / ?] } -punctchars -default { [list \{ \} \" \\ - _ + = . > , < ' : \; ` ~ ! @ # \$ % ^ & * \[ \] ( ) | / ?] }
" " {
@values
fileglob -type string -default * -optional 1 -multiple 1 -help\
"glob patterns to match against the filename portion (last segment) of each
file path. e.g *.tcl *.tm"
}
} }
#An implementation of a notoriously controversial metric. #An implementation of a notoriously controversial metric.
proc LOC {args} { proc LOC {args} {
set argd [punk::args::parse $args withid ::punk::LOC] set argd [punk::args::parse $args withid ::punk::LOC]
lassign [dict values $argd] leaders opts values received lassign [dict values $argd] leaders opts values received
set searchspecs [dict values $values] set searchspecs [dict get $values fileglob]
# -- --- --- --- --- --- # -- --- --- --- --- ---
set opt_return [dict get $opts -return] set opt_return [dict get $opts -return]
@ -7344,6 +7358,7 @@ namespace eval punk {
set cmdinfo [list] set cmdinfo [list]
lappend cmdinfo [list help "?topics?" "This help. To see available subitems type: help topics"] 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 i "cmd ?subcommand...?" "Show usage for a command or ensemble subcommand"]
lappend cmdinfo [list s "cmd ?subcommand...?" "Show synopsis for a command or ensemble subcommand"]
lappend cmdinfo [list ./ "?subdir?" "view/change directory"] lappend cmdinfo [list ./ "?subdir?" "view/change directory"]
lappend cmdinfo [list ../ "" "go up one directory"] lappend cmdinfo [list ../ "" "go up one directory"]
lappend cmdinfo [list ./new "subdir" "make new directory and switch to it"] lappend cmdinfo [list ./new "subdir" "make new directory and switch to it"]

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

File diff suppressed because it is too large Load Diff

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

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

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

File diff suppressed because it is too large Load Diff

6
src/modules/punk/console-999999.0a1.0.tm

@ -1239,7 +1239,7 @@ namespace eval punk::console {
lappend PUNKARGS [list { lappend PUNKARGS [list {
@id -id ::punk::console::show_input_response @id -id ::punk::console::show_input_response
@cmd -name punk::console::show_input_response -help\ @cmd -name punk::console::show_input_response -help\
"" "Debug command for console queries using ANSI"
@opts @opts
-terminal -default {stdin stdout} -type list -help\ -terminal -default {stdin stdout} -type list -help\
"terminal (currently list of in/out channels) (todo - object?)" "terminal (currently list of in/out channels) (todo - object?)"
@ -1247,9 +1247,9 @@ namespace eval punk::console {
"Number of ms to wait for response" "Number of ms to wait for response"
@values -min 1 -max 1 @values -min 1 -max 1
request -type string -help\ request -type string -help\
"ANSI sequence such as \x1b\[?6n which {ANSI sequence such as \x1b\[?6n which
should elicit a response by the terminal should elicit a response by the terminal
on stdin" on stdin}
}] }]
proc show_input_response {args} { proc show_input_response {args} {
set argd [punk::args::parse $args withid ::punk::console::show_input_response] set argd [punk::args::parse $args withid ::punk::console::show_input_response]

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

@ -1173,6 +1173,7 @@ namespace eval punk::lib {
-keysortdirection -default increasing -choices {increasing decreasing} -keysortdirection -default increasing -choices {increasing decreasing}
-debug -default 0 -type boolean -help\ -debug -default 0 -type boolean -help\
"When enabled, produces some rudimentary debug output on stderr" "When enabled, produces some rudimentary debug output on stderr"
-- -type none -optional 1
@values -min 1 -max -1 @values -min 1 -max -1
dictvalue -type list -help\ dictvalue -type list -help\
"dict or list value" "dict or list value"

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

@ -2510,8 +2510,12 @@ tcl::namespace::eval punk::ns {
punk::args::define { punk::args::define {
@id -id ::punk::ns::forms @id -id ::punk::ns::forms
@cmd -name punk::ns::forms -help\ @cmd -name punk::ns::forms\
"Return names for each form of a command" -summary\
"List command forms."\
-help\
"Return names for each form of a command.
Most commands are single-form and will only return the name '_default'."
@opts @opts
@values -min 1 -max -1 @values -min 1 -max -1
cmditem -multiple 1 -optional 0 cmditem -multiple 1 -optional 0
@ -2525,10 +2529,13 @@ tcl::namespace::eval punk::ns {
} }
punk::args::define { punk::args::define {
@id -id ::punk::ns::synopsis @id -id ::punk::ns::synopsis
@cmd -name punk::ns::synopsis -help\ @cmd -name punk::ns::synopsis\
-summary\
"Return command synopsis."\
-help\
"Return synopsis for each form of a command "Return synopsis for each form of a command
on separate lines. on separate lines.
If -form <formname> is given, supply only If -form formname|<int> is given, supply only
the synopsis for that form. the synopsis for that form.
" "
@opts @opts
@ -2564,8 +2571,12 @@ tcl::namespace::eval punk::ns {
full - summary { full - summary {
set resultstr "" set resultstr ""
foreach synline [split $syn \n] { foreach synline [split $syn \n] {
#append resultstr [join [lreplace $synline 0 0 {*}$idparts] " "] \n if {[string range $synline 0 1] eq "# "} {
append resultstr [join [lreplace $synline 0 [llength $resolved_id]-1 {*}$idparts] " "] \n append resultstr $synline \n
} else {
#append resultstr [join [lreplace $synline 0 0 {*}$idparts] " "] \n
append resultstr [join [lreplace $synline 0 [llength $resolved_id]-1 {*}$idparts] " "] \n
}
} }
set resultstr [string trimright $resultstr \n] set resultstr [string trimright $resultstr \n]
#set resultstr [join [lreplace $syn 0 0 {*}$idparts] " "] #set resultstr [join [lreplace $syn 0 0 {*}$idparts] " "]
@ -2591,7 +2602,10 @@ tcl::namespace::eval punk::ns {
punk::args::define { punk::args::define {
@dynamic @dynamic
@id -id ::punk::ns::arginfo @id -id ::punk::ns::arginfo
@cmd -name punk::ns::arginfo -help\ @cmd -name punk::ns::arginfo\
-summary\
"Command usage/help."\
-help\
"Show usage info for a command. "Show usage info for a command.
It supports the following: It supports the following:
1) Procedures or builtins for which a punk::args definition has 1) Procedures or builtins for which a punk::args definition has
@ -3020,8 +3034,11 @@ tcl::namespace::eval punk::ns {
set arglist [lindex $constructorinfo 0] set arglist [lindex $constructorinfo 0]
set argdef [punk::lib::tstr -return string { set argdef [punk::lib::tstr -return string {
@id -id "(autodef)${$origin} new" @id -id "(autodef)${$origin} new"
@cmd -name "${$origin} new" -help\ @cmd -name "${$origin} new"\
"create object with specified command name. -summary\
"Create new object instance."\
-help\
"create object with autogenerated command name.
Arguments are passed to the constructor." Arguments are passed to the constructor."
@values @values
}] }]
@ -3071,7 +3088,10 @@ tcl::namespace::eval punk::ns {
set arglist [lindex $constructorinfo 0] set arglist [lindex $constructorinfo 0]
set argdef [punk::lib::tstr -return string { set argdef [punk::lib::tstr -return string {
@id -id "(autodef)${$origin} create" @id -id "(autodef)${$origin} create"
@cmd -name "${$origin} create" -help\ @cmd -name "${$origin} create"\
-summary\
"Create new object instance with specified command name."\
-help\
"create object with specified command name. "create object with specified command name.
Arguments following objectName are passed to the constructor." Arguments following objectName are passed to the constructor."
@values -min 1 @values -min 1
@ -3124,7 +3144,10 @@ tcl::namespace::eval punk::ns {
# but we may want notes about a specific destructor # but we may want notes about a specific destructor
set argdef [punk::lib::tstr -return string { set argdef [punk::lib::tstr -return string {
@id -id "(autodef)${$origin} destroy" @id -id "(autodef)${$origin} destroy"
@cmd -name "destroy" -help\ @cmd -name "destroy"\
-summary\
"delete object instance."\
-help\
"delete object, calling destructor if any. "delete object, calling destructor if any.
destroy accepts no arguments." destroy accepts no arguments."
@values -min 0 -max 0 @values -min 0 -max 0
@ -3799,13 +3822,53 @@ tcl::namespace::eval punk::ns {
} }
punk::args::define {
@id -id ::punk::ns::pkguse
@cmd -name punk::ns::pkguse -help\
"Load package and move to namespace of the same name if run
interactively with only pkg/namespace argument.
if script and args are supplied, the
script runs in the namespace with the args passed to the script.
todo - further documentation"
@leaders -min 1 -max 1
pkg_or_existing_ns -type string
@opts
-vars -type none -help\
"whether to capture namespace vars for use in the supplied script"
-nowarnings -type none
@values -min 0 -max -1
script -type string -optional 1
arg -type any -optional 1 -multiple 1
}
#load package and move to namespace of same name if run interactively with only pkg/namespace argument. #load package and move to namespace of same name if run interactively with only pkg/namespace argument.
#if args is supplied - first word is script to run in the namespace remaining args are args passed to scriptblock #if args is supplied - first word is script to run in the namespace remaining args are args passed to scriptblock
#if no newline or $args in the script - treat as one-liner and supply {*}$args automatically #if no newline or $args in the script - treat as one-liner and supply {*}$args automatically
proc pkguse {pkg_or_existing_ns args} { proc pkguse {args} {
lassign [internal::get_run_opts {-vars -nowarnings} {} $args] _r runopts _c cmdargs set argd [punk::args::parse $args withid ::punk::ns::pkguse]
set use_vars [expr {"-vars" in $runopts}] lassign [dict values $argd] leaders opts values received
set no_warnings [expr {"-nowarnings" in $runopts}] puts stderr "leaders:$leaders opts:$opts values:$values received:$received"
set pkg_or_existing_ns [dict get $leaders pkg_or_existing_ns]
if {[dict exists $received script]} {
set scriptblock [dict get $values script]
} else {
set scriptblock ""
}
if {[dict exists $received arg]} {
set arglist [dict get $values arg]
} else {
set arglist [list]
}
set use_vars [dict exists $received "-vars"]
set no_warnings [dict exists $received "-nowarnings"]
#lassign [internal::get_run_opts {-vars -nowarnings} {} $args] _r runopts _c cmdargs
#set use_vars [expr {"-vars" in $runopts}]
#set no_warnings [expr {"-nowarnings" in $runopts}]
set ver "" set ver ""
@ -3883,7 +3946,7 @@ tcl::namespace::eval punk::ns {
} }
} }
if {[tcl::namespace::exists $ns]} { if {[tcl::namespace::exists $ns]} {
if {[llength $cmdargs]} { if {[dict exists $received script]} {
set binding {} set binding {}
#if {[info level] == 1} { #if {[info level] == 1} {
# #up 1 is global # #up 1 is global
@ -3923,7 +3986,7 @@ tcl::namespace::eval punk::ns {
} ] } ]
set arglist [lassign $cmdargs scriptblock] #set arglist [lassign $cmdargs scriptblock]
if {[string first "\n" $scriptblock] <0 && [string first {$args} $scriptblock] <0} { if {[string first "\n" $scriptblock] <0 && [string first {$args} $scriptblock] <0} {
#one liner without use of $args #one liner without use of $args
append scriptblock { {*}$args} append scriptblock { {*}$args}

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

@ -420,7 +420,11 @@ tcl::namespace::eval punk::zip {
punk::args::define { punk::args::define {
@id -id ::punk::zip::Addentry @id -id ::punk::zip::Addentry
@cmd -name punk::zip::Addentry -help "Add a single file at 'path' to open channel 'zipchan' @cmd -name punk::zip::Addentry\
-summary\
"Add zip-entry for file at 'path'"\
-help\
"Add a single file at 'path' to open channel 'zipchan'
return a central directory file record" return a central directory file record"
@opts @opts
-comment -default "" -help "An optional comment specific to the added file" -comment -default "" -help "An optional comment specific to the added file"
@ -543,7 +547,7 @@ tcl::namespace::eval punk::zip {
puts -nonewline $zipchan $ddesc puts -nonewline $zipchan $ddesc
} }
} }
#PK\x01\x02 Cdentral directory file header #PK\x01\x02 Cdentral directory file header
#set v1 0x0317 ;#upper byte 03 -> UNIX lower byte 23 -> 2.3 #set v1 0x0317 ;#upper byte 03 -> UNIX lower byte 23 -> 2.3
set v1 0x0017 ;#upper byte 00 -> MS_DOS and OS/2 (FAT/VFAT/FAT32 file systems) set v1 0x0017 ;#upper byte 00 -> MS_DOS and OS/2 (FAT/VFAT/FAT32 file systems)
@ -565,7 +569,10 @@ tcl::namespace::eval punk::zip {
punk::args::define { punk::args::define {
@id -id ::punk::zip::mkzip @id -id ::punk::zip::mkzip
@cmd -name punk::zip::mkzip\ @cmd -name punk::zip::mkzip\
-help "Create a zip archive in 'filename'" -summary\
"Create a zip archive in 'filename'."\
-help\
"Create a zip archive in 'filename'"
@opts @opts
-offsettype -default "archive" -choices {archive file}\ -offsettype -default "archive" -choices {archive file}\
-help "zip offsets stored relative to start of entire file or relative to start of zip-archive -help "zip offsets stored relative to start of entire file or relative to start of zip-archive

107
src/modules/shellrun-0.1.1.tm

@ -249,7 +249,29 @@ namespace eval shellrun {
dict incr ::tcl::UnknownOptions -level dict incr ::tcl::UnknownOptions -level
return -options $::tcl::UnknownOptions $::tcl::UnknownResult return -options $::tcl::UnknownOptions $::tcl::UnknownResult
} }
lappend PUNKARGS [list {
@id -id ::shellrun::runout
@leaders -min 0 -max 0
@opts
-echo -type none
-nonewline -type none
-tcl -type none -default 0
-debug -type none -default 0
--timeout= -type integer
@values -min 1 -max -1
cmdname -type string
cmdarg -type any -multiple 1 -optional 1
}]
proc runout {args} { proc runout {args} {
set argd [punk::args::parse $args withid ::shellrun::runout]
lassign [dict values $argd] leaders opts values received
if {[dict exists $received "-nonewline"]} {
set nonewline 1
} else {
set nonewline 0
}
#set_last_run_display [list] #set_last_run_display [list]
variable runout variable runout
variable runerr variable runerr
@ -257,15 +279,10 @@ namespace eval shellrun {
set runerr "" set runerr ""
set RST [a] set RST [a]
set splitargs [get_run_opts $args] #set splitargs [get_run_opts $args]
set runopts [dict get $splitargs runopts] #set runopts [dict get $splitargs runopts]
set cmdargs [dict get $splitargs cmdargs] #set cmdargs [dict get $splitargs cmdargs]
if {"-nonewline" in $runopts} {
set nonewline 1
} else {
set nonewline 0
}
#puts stdout "RUNOUT cmdargs: $cmdargs" #puts stdout "RUNOUT cmdargs: $cmdargs"
@ -275,7 +292,7 @@ namespace eval shellrun {
#set outvar_stackid [shellfilter::stack::add commandout tee_to_var -action float -settings {-varname ::runout}] #set outvar_stackid [shellfilter::stack::add commandout tee_to_var -action float -settings {-varname ::runout}]
# #
#when not echoing - use float-locked so that the repl's stack is bypassed #when not echoing - use float-locked so that the repl's stack is bypassed
if {"-echo" in $runopts} { if {[dict exists $received "-echo"]} {
set stdout_stackid [shellfilter::stack::add stdout tee_to_var -action float-locked -settings {-varname ::shellrun::runout}] set stdout_stackid [shellfilter::stack::add stdout tee_to_var -action float-locked -settings {-varname ::shellrun::runout}]
set stderr_stackid [shellfilter::stack::add stderr tee_to_var -action float-locked -settings {-varname ::shellrun::runerr}] set stderr_stackid [shellfilter::stack::add stderr tee_to_var -action float-locked -settings {-varname ::shellrun::runerr}]
#set stderr_stackid [shellfilter::stack::add stderr tee_to_var -action sink-locked -settings {-varname ::shellrun::runerr}] #set stderr_stackid [shellfilter::stack::add stderr tee_to_var -action sink-locked -settings {-varname ::shellrun::runerr}]
@ -284,10 +301,23 @@ namespace eval shellrun {
set stderr_stackid [shellfilter::stack::add stderr var -action float-locked -settings {-varname ::shellrun::runerr}] set stderr_stackid [shellfilter::stack::add stderr var -action float-locked -settings {-varname ::shellrun::runerr}]
} }
set callopts "" set callopts [dict create]
if {"-tcl" in $runopts} { if {[dict exists $received "-tcl"]} {
append callopts " -tclscript 1" dict set callopts -tclscript 1
}
if {[dict exists $received "-debug"]} {
dict set callopts -debug 1
}
if {[dict exists $received --timeout]} {
dict set callopts -timeout [dict get $opts --timeout] ;#convert to single dash
}
set cmdname [dict get $values cmdname]
if {[dict exists $received cmdarg]} {
set cmdarglist [dict get $values cmdarg]
} else {
set cmdarglist {}
} }
set cmdargs [concat $cmdname $cmdarglist]
#shellfilter::run [lrange $args 1 end] -teehandle punksh -outchan stdout -inbuffering none -outbuffering none -stdinhandler ::repl::repl_handler #shellfilter::run [lrange $args 1 end] -teehandle punksh -outchan stdout -inbuffering none -outbuffering none -stdinhandler ::repl::repl_handler
set exitinfo [shellfilter::run $cmdargs {*}$callopts -teehandle punksh -inbuffering none -outbuffering none ] set exitinfo [shellfilter::run $cmdargs {*}$callopts -teehandle punksh -inbuffering none -outbuffering none ]
@ -301,7 +331,7 @@ namespace eval shellrun {
#shellfilter::stack::remove commandout $outvar_stackid #shellfilter::stack::remove commandout $outvar_stackid
if {[dict exists $exitinfo error]} { if {[dict exists $exitinfo error]} {
if {"-tcl" in $runopts} { if {[dict exists $received "-tcl"]} {
} else { } else {
#we must raise an error. #we must raise an error.
@ -382,28 +412,61 @@ namespace eval shellrun {
} }
} }
lappend PUNKARGS [list {
@id -id ::shellrun::runerr
@leaders -min 0 -max 0
@opts
-echo -type none
-nonewline -type none
-tcl -type none -default 0
-debug -type none -default 0
--timeout= -type integer
@values -min 1 -max -1
cmdname -type string
cmdarg -type any -multiple 1 -optional 1
}]
proc runerr {args} { proc runerr {args} {
set argd [punk::args::parse $args withid ::shellrun::runout]
lassign [dict values $argd] leaders opts values received
if {[dict exists $received "-nonewline"]} {
set nonewline 1
} else {
set nonewline 0
}
#set_last_run_display [list] #set_last_run_display [list]
variable runout variable runout
variable runerr variable runerr
set runout "" set runout ""
set runerr "" set runerr ""
set splitargs [get_run_opts $args] #set splitargs [get_run_opts $args]
set runopts [dict get $splitargs runopts] #set runopts [dict get $splitargs runopts]
set cmdargs [dict get $splitargs cmdargs] #set cmdargs [dict get $splitargs cmdargs]
if {"-nonewline" in $runopts} { set callopts [dict create]
set nonewline 1 if {[dict exists $received "-tcl"]} {
dict set callopts -tclscript 1
}
if {[dict exists $received "-debug"]} {
dict set callopts -debug 1
}
if {[dict exists $received --timeout]} {
dict set callopts -timeout [dict get $opts --timeout] ;#convert to single dash
}
set cmdname [dict get $values cmdname]
if {[dict exists $received cmdarg]} {
set cmdarglist [dict get $values cmdarg]
} else { } else {
set nonewline 0 set cmdarglist {}
} }
set cmdargs [concat $cmdname $cmdarglist]
set callopts "" if {[dict exists $received "-tcl"]} {
if {"-tcl" in $runopts} {
append callopts " -tclscript 1" append callopts " -tclscript 1"
} }
if {"-echo" in $runopts} { if {[dict exists $received "-echo"]} {
set stderr_stackid [shellfilter::stack::add stderr tee_to_var -action float-locked -settings {-varname ::shellrun::runerr}] set stderr_stackid [shellfilter::stack::add stderr tee_to_var -action float-locked -settings {-varname ::shellrun::runerr}]
set stdout_stackid [shellfilter::stack::add stdout tee_to_var -action float-locked -settings {-varname ::shellrun::runout}] set stdout_stackid [shellfilter::stack::add stdout tee_to_var -action float-locked -settings {-varname ::shellrun::runout}]
} else { } else {

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

@ -265,4 +265,18 @@ namespace eval ::testspace {
-result [list\ -result [list\
"RECEIVED_EXPECTED_ERROR" "RECEIVED_EXPECTED_ERROR"
] ]
test parse_withdef_parsekey_repeat_ordering {Ensure last flag has precedence}\
-setup $common -body {
#It must always be possible to override earlier (non -multiple) options
set argd [punk::args::parse {-incr -decr -incr} withdef {@opts -type none -parsekey -direction} {-incr -typedefaults u} {-decr -typedefaults u}]
lappend result [dict get $argd opts]
}\
-cleanup {
}\
-result [list\
{-direction u}
]
} }

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

@ -9,6 +9,8 @@ namespace eval ::testspace {
} }
test synopsis_basic {test basic synopsis of punkargs definition}\ test synopsis_basic {test basic synopsis of punkargs definition}\
-setup $common -body { -setup $common -body {
#no @cmd -summary
#we still expect and require a leading line "# " in the synopsis
namespace eval testns { namespace eval testns {
punk::args::define { punk::args::define {
@id -id ::testspace::testns::t1 @id -id ::testspace::testns::t1
@ -26,7 +28,7 @@ namespace eval ::testspace {
namespace delete ::testspace::testns namespace delete ::testspace::testns
}\ }\
-result [list\ -result [list\
"::testspace::testns::t1 [a+ italic]a1[a] ?-o1 <bool>? ?[a+ italic]v1[a]?" "# \n::testspace::testns::t1 [a+ italic]a1[a+ noitalic] ?-o1 <[a+ italic]bool[a+ noitalic]>? ?[a+ italic]v1[a+ noitalic]?"
] ]
test synopsis_basic_ensemble-like {test basic synopsis of punkargs ensemble-like definition}\ test synopsis_basic_ensemble-like {test basic synopsis of punkargs ensemble-like definition}\
@ -34,12 +36,14 @@ namespace eval ::testspace {
namespace eval testns { namespace eval testns {
punk::args::define { punk::args::define {
@id -id ::testspace::testns::t1 @id -id ::testspace::testns::t1
@cmd -summary "summary"
@leaders @leaders
subcmd -default c1 -choices {c1 c2} subcmd -default c1 -choices {c1 c2}
@values -min 0 -max 0 @values -min 0 -max 0
} }
punk::args::define { punk::args::define {
@id -id "::testspace::testns::t1 c1" @id -id "::testspace::testns::t1 c1"
@cmd -summary "summary"
@values -min 0 -max 1 @values -min 0 -max 1
v1 -type string v1 -type string
} }
@ -52,9 +56,96 @@ namespace eval ::testspace {
namespace delete ::testspace::testns namespace delete ::testspace::testns
}\ }\
-result [list\ -result [list\
"::testspace::testns::t1 ?[a+ italic]subcmd[a]?"\ "# summary\n::testspace::testns::t1 ?[a+ italic]subcmd[a+ noitalic]?"\
"::testspace::testns::t1 c1 [a+ italic]v1[a]" "# summary\n::testspace::testns::t1 c1 [a+ italic]v1[a+ noitalic]"
] ]
test synopsis_alias_longopt_requiredval {}\
-setup $common -body {
namespace eval testns {
punk::args::define {
@id -id ::testspace::testns::t1
@cmd -summary summary
--verbose= -type int -default unreceived
}
}
lappend result [punk::ns::synopsis ::testspace::testns::t1]
#test that missing flag uses -default value
set argd [punk::args::parse {} withid ::testspace::testns::t1]
lappend result [dict get $argd opts]
#test prefix version of longopt accepts supplied int
set argd [punk::args::parse {--v=33} withid ::testspace::testns::t1]
lappend result [dict get $argd opts]
if {[catch {
set argd [punk::args::parse {--v=} withid ::testspace::testns::t1]
} eMsg eOpts]} {
lappend result "expected-error1"
} else {
lappend result "missing-required-error1"
}
if {[catch {
set argd [punk::args::parse {--v} withid ::testspace::testns::t1]
} eMsg eOpts]} {
lappend result "expected-error2"
} else {
lappend result "missing-required-error2"
}
}\
-cleanup {
namespace delete ::testspace::testns
}\
-result [list\
"# summary\n::testspace::testns::t1 ?--verbose=<[a+ italic]int[a+ noitalic]>?"\
{--verbose unreceived}\
{--verbose 33}\
expected-error1\
expected-error2
]
test synopsis_alias_longopt_optionalval {}\
-setup $common -body {
namespace eval testns {
punk::args::define {
@id -id ::testspace::testns::t1
@cmd -summary summary
--verbose= -type ?int? -default unreceived -typedefaults received
}
}
lappend result [punk::ns::synopsis ::testspace::testns::t1]
#test that missing flag uses -default value
set argd [punk::args::parse {} withid ::testspace::testns::t1]
lappend result [dict get $argd opts]
#test prefix version of longopt accepts supplied int
set argd [punk::args::parse {--v=33} withid ::testspace::testns::t1]
lappend result [dict get $argd opts]
if {[catch {
set argd [punk::args::parse {--v=} withid ::testspace::testns::t1]
} eMsg eOpts]} {
#expect fail due to received empty string failing <int>
lappend result "expected-error1"
} else {
lappend result "missing-required-error1"
}
#because the type is optional (?int?) - we expect the longopt to support solo operation.
#It should pick up the -typedefaults value as a default (not -default, which is for missing flag only)
set argd [punk::args::parse {--v} withid ::testspace::testns::t1]
lappend result [dict get $argd opts]
}\
-cleanup {
namespace delete ::testspace::testns
}\
-result [list\
"# summary\n::testspace::testns::t1 ?--verbose[a+ italic strike]?[a+ noitalic nostrike]=<[a+ italic]int[a+ noitalic]>[a+ italic strike]?[a+ noitalic nostrike]?"\
{--verbose unreceived}\
{--verbose 33}\
expected-error1\
{--verbose received}
]
} }

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

@ -137,11 +137,31 @@ tcl::namespace::eval textblock {
return " -choices \{$choices\} -help {algorithm choice $choicemsg} " return " -choices \{$choices\} -help {algorithm choice $choicemsg} "
} }
} }
namespace eval argdoc {
tcl::namespace::import ::punk::ansi::a+
# -- --- --- --- ---
#non colour SGR codes
# we can use these directly via ${$I} etc without marking a definition with @dynamic
#This is because they don't need to change when colour switched on and off.
set I [a+ italic]
set NI [a+ noitalic]
set B [a+ bold]
set N [a+ normal]
# -- --- --- --- ---
proc example {str} {
set str [string trimleft $str \n]
set block [punk::ansi::ansiwrap Web-gray [textblock::frame -ansibase [a+ Web-gray bold white] -ansiborder [a+ black White] -boxlimits {hl} -type block $str]]
set result [textblock::bookend_lines $block [a] "[a defaultbg] [a]"]
#puts $result
return $result
}
}
# hash_algorithm -optional 1 -choices {${[::textblock::argdoc::hash_algorithm_choices]}} -help\ # hash_algorithm -optional 1 -choices {${[::textblock::argdoc::hash_algorithm_choices]}} -help\
# "algorithm choice" # "algorithm choice"
namespace eval argdoc { namespace eval argdoc {
set DYN_HASH_ALGORITHM_CHOICES_AND_HELP {$[::textblock::argdoc::hash_algorithm_choices_and_help]} set DYN_HASH_ALGORITHM_CHOICES_AND_HELP {${[::textblock::argdoc::hash_algorithm_choices_and_help]}}
punk::args::define { punk::args::define {
@dynamic @dynamic
@id -id ::textblock::use_hash @id -id ::textblock::use_hash
@ -7769,75 +7789,93 @@ tcl::namespace::eval textblock {
# ${[textblock::frame_samples]} # ${[textblock::frame_samples]}
#todo punk::args alias for centre center etc? #todo punk::args alias for centre center etc?
punk::args::define { namespace eval argdoc {
@dynamic punk::args::define {
@id -id ::textblock::frame @dynamic
@cmd -name "textblock::frame"\ @id -id ::textblock::frame
-help "Frame a block of text with a border." @cmd -name "textblock::frame"\
-checkargs -default 1 -type boolean\ -summary "Frame a block of content with a border."\
-help "If true do extra argument checks and -help\
provide more comprehensive error info. "This command allows content to be framed with various border styles. The content can include
As the argument parser loads around 16 default frame other ANSI codes and unicode characters. Some predefined border types can be selected with
samples dynamically, this can add add up as each may the -type option and the characters can be overridden either in part or in total by supplying
take 10s of microseconds. For many-framed tables some or all entries in the -boxmap dictionary.
and other applications this can add up. The ${$B}textblock::framedef${$N} command can be used to return a dictionary for a frame type.
Set false for performance improvement." Border elements can also be suppressed on chosen sides with -boxlimits.
-etabs -default 0\ ANSI colours can be applied to borders or as defaults for the content using -ansiborder and
-help "expanding tabs - experimental/unimplemented." -ansibase options.
-type -default light -choices {${[textblock::frametypes]}} -choicerestricted 0 -choicecolumns 8 -type dict\ The punk::ansi::a+ function (aliased as a+) can be used to apply ANSI styles.
-choicelabels { e.g
${[textblock::frame_samples]} frame -type block -ansiborder [a+ blue Red] -ansibase [a+ black Red] \"A\\nB\""
}\ -checkargs -default 1 -type boolean\
-help "Type of border for frame." -help "If true do extra argument checks and
-boxlimits -default {hl vl tlc blc trc brc} -type list -help "Limit the border box to listed elements. provide more comprehensive error info.
passing an empty string will result in no box, but title/subtitle will still appear if supplied. As the argument parser loads around 16 default frame
${[textblock::EG]}e.g: -frame -boxlimits {} -title things [a+ red White]my\\ncontent${[textblock::RST]}" samples dynamically, this can add add up as each may
-boxmap -default {} -type dict take 10s of microseconds. For many-framed tables
-joins -default {} -type list and other applications this can add up.
-title -default "" -type string -regexprefail {\n}\ Set false for performance improvement."
-help "Frame title placed on topbar - no newlines. -etabs -default 0\
May contain ANSI - no trailing reset required. -help "expanding tabs - experimental/unimplemented."
${[textblock::EG]}e.g 1: frame -title My[a+ green]Green[a]Thing -type -default light\
e.g 2: frame -title [a+ red underline]MyThing${[textblock::RST]}" -type dict\
-titlealign -default "centre" -choices {left centre right} -typesynopsis {${$I}choice${$NI}|<${$I}dict${$NI}>}\
-subtitle -default "" -type string -regexprefail {\n}\ -choices {${[textblock::frametypes]}}\
-help "Frame subtitle placed on bottombar - no newlines -choicerestricted 0 -choicecolumns 8\
May contain Ansi - no trailing reset required." -choicelabels {
-subtitlealign -default "centre" -choices {left centre right} ${[textblock::frame_samples]}
-width -default "" -type int\ }\
-help "Width of resulting frame including borders. -help "Type of border for frame."
If omitted or empty-string, the width will be determined automatically based on content." -boxlimits -default {hl vl tlc blc trc brc} -type list -help "Limit the border box to listed elements.
-height -default "" -type int\ passing an empty string will result in no box, but title/subtitle will still appear if supplied.
-help "Height of resulting frame including borders." ${[textblock::EG]}e.g: -frame -boxlimits {} -title things [a+ red White]my\\ncontent${[textblock::RST]}"
-ansiborder -default "" -type ansistring\ -boxmap -default {} -type dict
-help "Ansi escape sequence to set border attributes. -joins -default {} -type list
${[textblock::EG]}e.g 1: frame -ansiborder [a+ web-red] contents -title -default "" -type string -regexprefail {\n}\
e.g 2: frame -ansiborder \"\\x1b\\\[31m\" contents${[textblock::RST]}" -help "Frame title placed on topbar - no newlines.
-ansibase -default "" -type ansistring\ May contain ANSI - no trailing reset required.
-help "Default ANSI attributes within frame." ${[textblock::EG]}e.g 1: frame -title My[a+ green]Green[a]Thing
-blockalign -default centre -choices {left right centre}\ e.g 2: frame -title [a+ red underline]MyThing${[textblock::RST]}"
-help "Alignment of the content block within the frame." -titlealign -default "centre" -choices {left centre right}
-pad -default 1 -type boolean -help "Whether to pad within the ANSI so content background -subtitle -default "" -type string -regexprefail {\n}\
extends within the content block inside the frame. -help "Frame subtitle placed on bottombar - no newlines
Has no effect if no ANSI in content." May contain Ansi - no trailing reset required."
-textalign -default left -choices {left right centre}\ -subtitlealign -default "centre" -choices {left centre right}
-help "Alignment of text within the content block. (centre unimplemented)" -width -default "" -type int\
-ellipsis -default 1 -type boolean\ -help "Width of resulting frame including borders.
-help "Whether to show elipsis for truncated content and title/subtitle." If omitted or empty-string, the width will be determined automatically based on content."
-usecache -default 1 -type boolean -height -default "" -type int\
-buildcache -default 1 -type boolean -help "Height of resulting frame including borders."
-crm_mode -default 0 -type boolean\ -ansiborder -default "" -type ansistring\
-help "Show ANSI control characters within frame contents. -help "Ansi escape sequence to set border attributes.
(Control Representation Mode) ${[textblock::EG]}e.g 1: frame -ansiborder [a+ web-red] contents
Frame width doesn't adapt and content may be truncated e.g 2: frame -ansiborder \"\\x1b\\\[31m\" contents${[textblock::RST]}"
so -width may need to be manually set to display more." -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 @values -min 0 -max 1
contents -default "" -type string\ contents -default "" -type string\
-help "Frame contents - may be a block of text containing newlines and ANSI. -help "Frame contents - may be a block of text containing newlines and ANSI.
Text may be 'ragged' - ie unequal line-lengths. Text may be 'ragged' - ie unequal line-lengths.
No trailing ANSI reset required. No trailing ANSI reset required.
${[textblock::EG]}e.g: frame \"[a+ blue White] \\nMy blue foreground text on\\nwhite background\\n\"${[textblock::RST]}" ${[textblock::EG]}e.g: frame \"[a+ blue White] \\nMy blue foreground text on\\nwhite background\\n\"${[textblock::RST]}"
}
} }
#options before content argument - which is allowed to be absent #options before content argument - which is allowed to be absent

Loading…
Cancel
Save