@ -295,6 +295,8 @@ tcl::namespace::eval ::punk::args::helpers {
tcl\ tcl\
" Very basic tcl syntax highlighting " Very basic tcl syntax highlighting
of braces,square brackets and comments." of braces,square brackets and comments."
-title -type string -default ""
-titlealign -type string -choices {left centre right}
} }
text -type string text -type string
}] }]
@ -313,10 +315,12 @@ tcl::namespace::eval ::punk::args::helpers {
set defaults [dict create\ set defaults [dict create\
-padright 2\ -padright 2\
-syntax tcl\ -syntax tcl\
-title ""\
-titlealign left\
] ]
dict for {o v} $optlist { dict for {o v} $optlist {
switch -- $o { switch -- $o {
-padright - -syntax {} -padright - -syntax - -title - -titlealign {}
default { default {
punk::args::parse $args withid ::punk::args::helpers::example punk::args::parse $args withid ::punk::args::helpers::example
return return
@ -324,8 +328,10 @@ tcl::namespace::eval ::punk::args::helpers {
} }
} }
set opts [dict merge $defaults $optlist] set opts [dict merge $defaults $optlist]
set opt_padright [dict get $opts -padright] set opt_padright [dict get $opts -padright]
set opt_syntax [dict get $opts -syntax] set opt_syntax [dict get $opts -syntax]
set opt_title [dict get $opts -title]
set opt_titlealign [dict get $opts -titlealign]
if {[string index $str 0] eq "\n"} { if {[string index $str 0] eq "\n"} {
set str [string range $str 1 end] set str [string range $str 1 end]
@ -342,7 +348,13 @@ tcl::namespace::eval ::punk::args::helpers {
if {$opt_padright > 0} { if {$opt_padright > 0} {
set str [textblock::join -- $str [string repeat " " $opt_padright]] set str [textblock::join -- $str [string repeat " " $opt_padright]]
} }
set str [punk::ansi::ansiwrap Web-gray [textblock::frame -ansibase [a+ Web-gray white] -ansiborder [a+ black White] -boxlimits {hl} -type block $str]]
if {$opt_title ne ""} {
set title "[a+ term-black Term-silver]$opt_title[a]"
} else {
set title ""
}
set str [punk::ansi::ansiwrap Term-grey [textblock::frame -ansibase [a+ Term-grey white] -ansiborder [a+ term-black Term-silver] -titlealign $opt_titlealign -title $title -boxlimits {hl} -type block $str]]
#puts stderr ------------------- #puts stderr -------------------
#puts $str #puts $str
#puts stderr ------------------- #puts stderr -------------------
@ -353,11 +365,11 @@ tcl::namespace::eval ::punk::args::helpers {
tcl { tcl {
#result lines often indicated in examples by \u2192 → #result lines often indicated in examples by \u2192 →
#however - it's not present on each line of output, instead indents are used - so we can't so easily highlight all appropriate rows(?) #however - it's not present on each line of output, instead indents are used - so we can't so easily highlight all appropriate rows(?)
set str [punk::grepstr -return all -highlight {Web-gra y term-darkgreen} {^\s*#.*} $str] ;#Note, will not highlight comments at end of line - like this one set str [punk::grepstr -return all -highlight {Term-gre y term-darkgreen} {^\s*#.*} $str] ;#Note, will not highlight comments at end of line - like this one
set str [punk::grepstr -return all -highlight {Web-gra y term-darkgreen} {;\s*(#.*)} $str] set str [punk::grepstr -return all -highlight {Term-gre y term-darkgreen} {;\s*(#.*)} $str]
#TODO - fix grepstr highlighting (bg issues - why?) #TODO - fix grepstr highlighting (bg issues - why?)
set str [punk::grepstr -return all -highlight {Web-gra y term-darkblue} {\{|\}} $str] set str [punk::grepstr -return all -highlight {Term-gre y term-darkblue} {\{|\}} $str]
set str [punk::grepstr -return all -highlight {Web-gra y term-orange1} {\[|\]} $str] set str [punk::grepstr -return all -highlight {Term-gre y term-orange1} {\[|\]} $str]
#puts stderr ------------------- #puts stderr -------------------
#puts $str #puts $str
#puts stderr ------------------- #puts stderr -------------------
@ -368,8 +380,8 @@ tcl::namespace::eval ::punk::args::helpers {
return $result return $result
} }
lappend PUNKARGS [list { lappend PUNKARGS [list {
@id -id ::punk::args::helpers::strip_nodisplay_comment s @id -id ::punk::args::helpers::strip_nodisplay_line s
@cmd -name punk::args::helpers::strip_nodisplay_comment s\ @cmd -name punk::args::helpers::strip_nodisplay_line s\
-summary\ -summary\
"strip #<nodisplay> lines."\ "strip #<nodisplay> lines."\
-help\ -help\
@ -378,13 +390,13 @@ tcl::namespace::eval ::punk::args::helpers {
prior to examining each line for the #<nodisplay> tag." prior to examining each line for the #<nodisplay> tag."
@values -min 1 -max 1 @values -min 1 -max 1
text -optional 0 -help\ text -optional 0 -help\
" punk::args::define scripts must have properly balanced braces etc { punk::args::define scripts must have properly balanced braces etc
as per Tcl rules. as per Tcl rules.
Sometimes it is desired to display help text or examples demonstrating Sometimes it is desired to display help text or examples demonstrating
unbalanced braces etc, but without escaping it in a way that shows the unbalanced braces etc, but without escaping it in a way that shows the
escaping backslash in the help text. This balancing requirement includes escaping backslash in the help text. This balancing requirement includes
curly braces in comments. eg curly braces in comments. eg
${[punk::args::helpers::example { ${[punk::args::helpers::example -title " Example 1a " {
proc bad_syntax {args} { proc bad_syntax {args} {
#eg this is an unbalanced left curly brace { #eg this is an unbalanced left curly brace {
#<nodisplay> balancing right curly brace } #<nodisplay> balancing right curly brace }
@ -397,7 +409,7 @@ tcl::namespace::eval ::punk::args::helpers {
The actual text is in a placeholder call to punk::args::helpers::example The actual text is in a placeholder call to punk::args::helpers::example
to provide basic syntax highlighting and box background, and looks like to provide basic syntax highlighting and box background, and looks like
the following, but without the left-hand side pipe symbols. the following, but without the left-hand side pipe symbols.
${[punk::args::helpers::example -syntax none { ${[punk::args::helpers::example -syntax none -title " Example 1b " {
| proc bad_syntax {args} { | proc bad_syntax {args} {
| #eg this is an unbalanced left curly brace { | #eg this is an unbalanced left curly brace {
| #<nodisplay> balancing right curly brace } | #<nodisplay> balancing right curly brace }
@ -405,20 +417,33 @@ tcl::namespace::eval ::punk::args::helpers {
| } | }
}]} }]}
Technically a proc body can exist with an unbalanced brace in a comment
like that and would still run without issue. However, such a definition
couldn't be placed in a tcl file to be sourced, nor directly evaluated
with eval.
A #<nodisplay> comment can also be used just for commenting the help A #<nodisplay> comment can also be used just for commenting the help
source inline. source inline.
Note that an opening square bracket can't be balanced by a line beginning
The ${[B]}strip_nodisplay_comments${[N]} function is called automatically with the # character.
The non-comment form @#<nodisplay> is available so help lines beginning
with this token will also be stripped. This can be used to 'close' a
section of text that happens to look like a command block. This should
only be used if there is some reason the opening square bracket can't
be rewritten in the help doc to be escaped with a backslash.
The ${[B]}strip_nodisplay_lines${[N]} function is called automatically
by the help text generators in punk::args, and generally shouldn't need by the help text generators in punk::args, and generally shouldn't need
to be used directly, but nevertheless resides in in punk::args::helpers to be used directly, but nevertheless resides in in punk::args::helpers
alongside the ${[B]}example${[N]} function which is intended for writers alongside the ${[B]}example${[N]} function which is intended for writers
of punk::args::define scripts (command documentors) to use. of punk::args::define scripts (command documentors) to use.
" }
}] }]
proc strip_nodisplay_comments {text} { proc strip_nodisplay_line s {text} {
set display "" set display ""
foreach ln [split $text \n] { foreach ln [split $text \n] {
if {![string match "#<nodisplay>*" [string trimleft [punk::ansi::ansistrip $ln]]]} { set stripped [string trimleft [punk::ansi::ansistrip $ln]]
if {![string match "#<nodisplay>*" $stripped] && ![string match "@#<nodisplay>*" $stripped]} {
append display $ln \n append display $ln \n
} }
} }
@ -578,6 +603,7 @@ tcl::namespace::eval punk::args {
directive-options: -help <str> directive-options: -help <str>
%B%@seealso%N% ?opt val...? %B%@seealso%N% ?opt val...?
directive-options: -name <str> -url <str> (for footer - unimplemented) directive-options: -name <str> -url <str> (for footer - unimplemented)
%B%@instance%N% ?opt val...?
Some other options normally present on custom arguments are available Some other options normally present on custom arguments are available
to use with the @leaders @opts @values directives to set defaults to use with the @leaders @opts @values directives to set defaults
@ -789,9 +815,15 @@ tcl::namespace::eval punk::args {
column. column.
For the @examples directive this is the text for examples as For the @examples directive this is the text for examples as
displayed with 'eg <commandname>' displayed with 'eg <commandname>'
The -help string can be delimited with double quotes or with
curly braces, the choice will affect what inner chars require
backslash escaping - but neither type of help block is
automatically subject to variable or command substitution aside
from those specifically wrapped in placeholders.
For cases where unbalanced braces, double quotes are to For cases where unbalanced braces, double quotes are to
be displayed to the user without visible backslash escapes, be displayed to the user without visible backslash escapes,
see 'i ::punk::args::helpers::strip_nodisplay_comments' see 'i ::punk::args::helpers::strip_nodisplay_line s'
" "
-dynamic -type boolean -default 0 -help\ -dynamic -type boolean -default 0 -help\
"If -dynamic is true, tstr interpolations of the form \$\{\$var\} "If -dynamic is true, tstr interpolations of the form \$\{\$var\}
@ -1363,13 +1395,15 @@ tcl::namespace::eval punk::args {
#puts stderr 4[lindex $records 4] #puts stderr 4[lindex $records 4]
#puts stderr 5[lindex $records 5] #puts stderr 5[lindex $records 5]
#puts stderr 6[lindex $records 6] #puts stderr 6[lindex $records 6]
set cmd_info {} set cmd_info {}
set package_info {} set package_info {}
set id_info {} ;#e.g -children <list> ?? set id_info {} ;#e.g -children <list> ??
set doc_info {} set doc_info {}
#set argdisplay_info {} ;#optional override of autogenerated 'Arg Type Default Multi Help' table #set argdisplay_info {} ;#optional override of autogenerated 'Arg Type Default Multi Help' table
set seealso_info {} set seealso_info {}
#set credits_info {} ;#e.g see interp man CREDITS section todo - where to display?
set instance_info {}
set keywords_info {} set keywords_info {}
set examples_info {} set examples_info {}
###set leader_min 0 ###set leader_min 0
@ -1401,8 +1435,9 @@ tcl::namespace::eval punk::args {
puts stdout "----------------------------------------------" puts stdout "----------------------------------------------"
puts stderr "rec: $rec" puts stderr "rec: $rec"
set ::testrecord $rec set ::testrecord $rec
puts "records: $records"
puts stdout "----------------------------------------------" puts stdout "----------------------------------------------"
puts "records: $records"
puts stdout "=============================================="
} }
set record_values [lassign $trimrec firstword] ;#after first word, the remaining list elements up to the first newline that isn't inside a value, form a dict set record_values [lassign $trimrec firstword] ;#after first word, the remaining list elements up to the first newline that isn't inside a value, form a dict
if {[llength $record_values] % 2 != 0} { if {[llength $record_values] % 2 != 0} {
@ -2046,6 +2081,10 @@ tcl::namespace::eval punk::args {
#like @doc, except displays in footer, multiple - sub-table? #like @doc, except displays in footer, multiple - sub-table?
set seealso_info [dict merge $seealso_info $at_specs] set seealso_info [dict merge $seealso_info $at_specs]
} }
instance {
#todo!
set instance_info [dict merge $instance_info $at_specs]
}
keywords { keywords {
#review - put as option on @cmd instead? @cmd -name xxx -keywords {blah etc hmm} ?? #review - put as option on @cmd instead? @cmd -name xxx -keywords {blah etc hmm} ??
set keywords_info [dict merge $keywords_info $at_specs] set keywords_info [dict merge $keywords_info $at_specs]
@ -2621,6 +2660,7 @@ tcl::namespace::eval punk::args {
doc_info $doc_info\ doc_info $doc_info\
package_info $package_info\ package_info $package_info\
seealso_info $seealso_info\ seealso_info $seealso_info\
instance_info $instance_info\
keywords_info $keywords_info\ keywords_info $keywords_info\
examples_info $examples_info\ examples_info $examples_info\
id_info $id_info\ id_info $id_info\
@ -2653,9 +2693,9 @@ tcl::namespace::eval punk::args {
namespace eval argdoc { namespace eval argdoc {
variable resolved_def_TYPE_CHOICES {* @id @package @cmd @ref @doc @examples @formdisplay @seealso @leaders @opts @values leaders opts values} variable resolved_def_TYPE_CHOICES {* @id @package @cmd @ref @doc @examples @formdisplay @seealso @instance @ leaders @opts @values leaders opts values}
variable resolved_def_TYPE_CHOICEGROUPS { variable resolved_def_TYPE_CHOICEGROUPS {
directives {@id @package @cmd @ref @doc @examples @formdisplay @seealso} directives {@id @package @cmd @ref @doc @examples @formdisplay @seealso @instance }
argumenttypes {leaders opts values} argumenttypes {leaders opts values}
remaining_defaults {@leaders @opts @values} remaining_defaults {@leaders @opts @values}
} }
@ -2872,7 +2912,7 @@ tcl::namespace::eval punk::args {
dict set resultdict @id [list -id [dict get $specdict id]] dict set resultdict @id [list -id [dict get $specdict id]]
} }
} }
foreach directive {@package @cmd @doc @examples @seealso} { foreach directive {@package @cmd @doc @examples @seealso @instance } {
set dshort [string range $directive 1 end] set dshort [string range $directive 1 end]
if {"$directive" in $included_directives} { if {"$directive" in $included_directives} {
if {[dict exists $opt_override $directive]} { if {[dict exists $opt_override $directive]} {
@ -2939,7 +2979,7 @@ tcl::namespace::eval punk::args {
} }
} }
} }
@package - @cmd - @doc - @examples - @seealso { @package - @cmd - @doc - @examples - @seealso - @instance {
if {"$type" in $included_directives} { if {"$type" in $included_directives} {
set tp [string range $type 1 end] ;# @package -> package set tp [string range $type 1 end] ;# @package -> package
if {[dict exists $opt_override $type]} { if {[dict exists $opt_override $type]} {
@ -3863,7 +3903,7 @@ tcl::namespace::eval punk::args {
lappend blank_header_col "" lappend blank_header_col ""
#set cmdhelp_display [a+ brightwhite]$cmdhelp[a] #set cmdhelp_display [a+ brightwhite]$cmdhelp[a]
#set cmdhelp_display [textblock::ansibase_lines $cmdhelp $CLR(linebase_header)] #set cmdhelp_display [textblock::ansibase_lines $cmdhelp $CLR(linebase_header)]
set cmdhelp [punk::args::helpers::strip_nodisplay_comment s $cmdhelp] set cmdhelp [punk::args::helpers::strip_nodisplay_line s $cmdhelp]
set cmdhelp_display [punk::ansi::ansiwrap_raw $CLR(linebase_header) "" "" $cmdhelp] set cmdhelp_display [punk::ansi::ansiwrap_raw $CLR(linebase_header) "" "" $cmdhelp]
} else { } else {
set cmdhelp_display "" set cmdhelp_display ""
@ -4248,7 +4288,7 @@ tcl::namespace::eval punk::args {
} }
set unindentedfields [Dict_getdef $arginfo -unindentedfields {}] set unindentedfields [Dict_getdef $arginfo -unindentedfields {}]
set help [Dict_getdef $arginfo -help ""] set help [Dict_getdef $arginfo -help ""]
set help [punk::args::helpers::strip_nodisplay_comment s $help] set help [punk::args::helpers::strip_nodisplay_line s $help]
set allchoices_originalcase [list] set allchoices_originalcase [list]
set choices [Dict_getdef $arginfo -choices {}] set choices [Dict_getdef $arginfo -choices {}]
set choicegroups [Dict_getdef $arginfo -choicegroups {}] set choicegroups [Dict_getdef $arginfo -choicegroups {}]
@ -4804,7 +4844,6 @@ tcl::namespace::eval punk::args {
Will usually match the command name" Will usually match the command name"
}] }]
proc usage {args} { proc usage {args} {
#lassign [dict values [punk::args::get_by_id ::punk::args::usage $args]] leaders opts values received
lassign [dict values [punk::args::parse $args withid ::punk::args::usage]] leaders opts values received lassign [dict values [punk::args::parse $args withid ::punk::args::usage]] leaders opts values received
set id [dict get $values id] set id [dict get $values id]
set real_id [real_id $id] set real_id [real_id $id]
@ -4909,6 +4948,12 @@ tcl::namespace::eval punk::args {
#default to enhanced errorstyle despite slow 'catch' (unhappy path) performance #default to enhanced errorstyle despite slow 'catch' (unhappy path) performance
#todo - configurable per interp/namespace #todo - configurable per interp/namespace
-errorstyle -type string -default enhanced -choices {enhanced standard basic minimal} -errorstyle -type string -default enhanced -choices {enhanced standard basic minimal}
-cache -type boolean -default 0 -help\
{Use sparingly.
This uses a cache for same arguments being parsed against
the same definition.
It is a minor speedup suitable for when a small set of similar
(and generally small) arguments are repeatedly used by a function.}
@values -min 2 @values -min 2
@ -4934,6 +4979,7 @@ tcl::namespace::eval punk::args {
how to process the definition." how to process the definition."
}] }]
variable parse_cache [dict create]
proc parse {args} { proc parse {args} {
#puts "punk::args::parse --> '$args'" #puts "punk::args::parse --> '$args'"
set tailtype "" ;#withid|withdef set tailtype "" ;#withid|withdef
@ -4998,6 +5044,7 @@ tcl::namespace::eval punk::args {
set defaultopts [dict create\ set defaultopts [dict create\
-form {*}\ -form {*}\
-errorstyle standard\ -errorstyle standard\
-cache 0\
] ]
#todo - load override_errorstyle from configuration #todo - load override_errorstyle from configuration
@ -5006,7 +5053,7 @@ tcl::namespace::eval punk::args {
set opts [dict merge $defaultopts $opts] set opts [dict merge $defaultopts $opts]
dict for {k v} $opts { dict for {k v} $opts {
switch -- $k { switch -- $k {
-form - -errorstyle { -form - -errorstyle - -cache {
} }
default { default {
#punk::args::usage $args withid ::punk::args::parse ?? #punk::args::usage $args withid ::punk::args::parse ??
@ -5043,7 +5090,19 @@ tcl::namespace::eval punk::args {
} }
try { try {
#puts stdout "parse --> get_dict <deflist> $parseargs -form [dict get $opts -form]" #puts stdout "parse --> get_dict <deflist> $parseargs -form [dict get $opts -form]"
set result [punk::args::get_dict $deflist $parseargs -form [dict get $opts -form]] if {![dict get $opts -cache]} {
set result [punk::args::get_dict $deflist $parseargs -form [dict get $opts -form]]
} else {
variable parse_cache
set key [list $parseargs $deflist [dict get $opts -form]]
if {[dict exists $parse_cache $key]} {
set result [dict get $parse_cache $key]
} else {
set result [punk::args::get_dict $deflist $parseargs -form [dict get $opts -form]]
dict set parse_cache $key $result
}
return $result
}
} trap {PUNKARGS VALIDATION} {msg erroropts} { } trap {PUNKARGS VALIDATION} {msg erroropts} {
set opt_errorstyle [dict get $opts -errorstyle] set opt_errorstyle [dict get $opts -errorstyle]
@ -7397,7 +7456,7 @@ tcl::namespace::eval punk::args {
# ----------------------------------------------- # -----------------------------------------------
# Warning - be aware of all vars thrown into this space (from tail end of 'definition' proc) # Warning - be aware of all vars thrown into this space (from tail end of 'definition' proc)
tcl::dict::with argspecs {} ;#turn keys into vars tcl::dict::with argspecs {} ;#turn keys into vars
#e.g id,FORMS,cmd_info,doc_info,package_info,seealso_info,id_info,form_names #e.g id,FORMS,cmd_info,doc_info,package_info,seealso_info, instance_info, id_info,form_names
# ----------------------------------------------- # -----------------------------------------------
set opt_form [dict get $proc_opts -form] set opt_form [dict get $proc_opts -form]
if {$opt_form eq "*"} { if {$opt_form eq "*"} {
@ -9349,7 +9408,7 @@ tcl::namespace::eval punk::args {
} }
if {[dict exists $spec examples_info -help]} { if {[dict exists $spec examples_info -help]} {
set egdata [dict get $spec examples_info -help] set egdata [dict get $spec examples_info -help]
return [punk::args::helpers::strip_nodisplay_comment s $egdata] return [punk::args::helpers::strip_nodisplay_line s $egdata]
} else { } else {
return "no @examples defined for $id" return "no @examples defined for $id"
} }
@ -9374,7 +9433,8 @@ tcl::namespace::eval punk::args {
cmditem -multiple 1 -optional 0 cmditem -multiple 1 -optional 0
}] }]
proc synopsis {args} { proc synopsis {args} {
set argd [punk::args::parse $args withid ::punk::args::synopsis] #synopsis potentially called repeatedly with same args? use -cache 1
set argd [punk::args::parse $args -cache 1 withid ::punk::args::synopsis]
if {[catch {package require punk::ansi} errM]} { if {[catch {package require punk::ansi} errM]} {
set has_punkansi 0 set has_punkansi 0
