@ -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,9 +2571,13 @@ tcl::namespace::eval punk::ns {
full - summary { full - summary {
set resultstr "" set resultstr ""
foreach synline [split $syn \n] { foreach synline [split $syn \n] {
if {[string range $synline 0 1] eq "# "} {
append resultstr $synline \n
} else {
#append resultstr [join [lreplace $synline 0 0 {*}$idparts] " "] \n #append resultstr [join [lreplace $synline 0 0 {*}$idparts] " "] \n
append resultstr [join [lreplace $synline 0 [llength $resolved_id]-1 {*}$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] " "]
return $resultstr return $resultstr
@ -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}
