@ -270,6 +270,165 @@ tcl::namespace::eval punk::args::register {
tcl::namespace::eval ::punk::args {}
tcl::namespace::eval ::punk::args::helpers {
variable PUNKARGS
namespace export *
#proc B {} {return \x1b\[1m} ;#a+ bold
#proc N {} {return \x1b\[22m} ;#a+ normal
#proc I {} {return \x1b\[3m} ;#a+ italic
#proc NI {} {return \x1b\[23m} ;#a+ noitalic
proc I {} {punk::ansi::a+ italic}
proc B {} {punk::ansi::a+ bold}
proc N {} {punk::ansi::a+ normal}
proc NI {} {punk::ansi::a+ italic}
lappend PUNKARGS [list {
@id -id ::punk::args::helpers::example
@cmd -name punk::args::helpers::example\
-summary\
{Display formatting for argdoc example text}\
-help\
{Wrap }
@opts
-padright -type integer -default 2 -help\
{Number of padding spaces to add on RHS of text block}
-syntax -type string -default tcl -choices {none tcl} -choicelabels {
tcl\
" Very basic tcl syntax highlighting
of braces,square brackets and comments."
}
text -type string
}]
proc example {args} {
#only use punk::args::parse on the unhappy path
if {[llength $args] == 0} {
punk::args::parse $args withid ::punk::args::helpers::example
return
}
set str [lindex $args end]
set optlist [lrange $args 0 end-1]
if {[llength $optlist] %2 != 0} {
punk::args::parse $args withid ::punk::args::helpers::example
return
}
set defaults [dict create\
-padright 2\
-syntax tcl\
]
dict for {o v} $optlist {
switch -- $o {
-padright - -syntax {}
default {
punk::args::parse $args withid ::punk::args::helpers::example
return
}
}
}
set opts [dict merge $defaults $optlist]
set opt_padright [dict get $opts -padright]
set opt_syntax [dict get $opts -syntax]
if {[string index $str 0] eq "\n"} {
set str [string range $str 1 end]
}
if {[string index $str end] eq "\n"} {
set str [string range $str 0 end-1]
}
#example is intended to run from a source doc that has already been dedented appropriately based on context
# - we don't want to further undent, hence -undent 0
set str [uplevel 1 [list punk::lib::tstr -undent 0 -return string -eval 1 -allowcommands $str]]
#puts stderr -------------------
#puts $str
#puts stderr -------------------
if {$opt_padright > 0} {
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]]
#puts stderr -------------------
#puts $str
#puts stderr -------------------
#rudimentary colourising (not full tcl syntax parsing)
#highlight comments first - so that we can also highlight braces within comments to help with detecting unbalanced braces/square brackets in comments
switch -- $opt_syntax {
tcl {
#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(?)
set str [punk::grepstr -return all -highlight {Web-gray term-darkgreen} {^\s*#.*} $str] ;#Note, will not highlight comments at end of line - like this one
set str [punk::grepstr -return all -highlight {Web-gray term-darkgreen} {;\s*(#.*)} $str]
#TODO - fix grepstr highlighting (bg issues - why?)
set str [punk::grepstr -return all -highlight {Web-gray term-darkblue} {\{|\}} $str]
set str [punk::grepstr -return all -highlight {Web-gray term-orange1} {\[|\]} $str]
#puts stderr -------------------
#puts $str
#puts stderr -------------------
}
}
set result [textblock::bookend_lines $str [a] "[a defaultbg] [a]"]
return $result
}
lappend PUNKARGS [list {
@id -id ::punk::args::helpers::strip_nodisplay_comments
@cmd -name punk::args::helpers::strip_nodisplay_comments\
-summary\
"strip #<nodisplay> lines."\
-help\
"Strip lines beginning with #<nodisplay> from the supplied text.
Whitespace prior to #<nodisplay> is ignored, and ANSI is stripped
prior to examining each line for the #<nodisplay> tag."
@values -min 1 -max 1
text -optional 0 -help\
"punk::args::define scripts must have properly balanced braces etc
as per Tcl rules.
Sometimes it is desired to display help text or examples demonstrating
unbalanced braces etc, but without escaping it in a way that shows the
escaping backslash in the help text. This balancing requirement includes
curly braces in comments. eg
${[punk::args::helpers::example {
proc bad_syntax {args} {
#eg this is an unbalanced left curly brace {
#<nodisplay> balancing right curly brace }
return $args
}
}]}
There is a second comment line in the above proc which begins
with #<nodisplay> and contains the balancing right curly brace.
This shouldn't show in the example above.
The actual text is in a placeholder call to punk::args::helpers::example
to provide basic syntax highlighting and box background, and looks like
the following, but without the left-hand side pipe symbols.
${[punk::args::helpers::example -syntax none {
| proc bad_syntax {args} {
| #eg this is an unbalanced left curly brace {
| #<nodisplay> balancing right curly brace }
| return $args
| }
}]}
A #<nodisplay> comment can also be used just for commenting the help
source inline.
The ${[B]}strip_nodisplay_comments${[N]} function is called automatically
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
alongside the ${[B]}example${[N]} function which is intended for writers
of punk::args::define scripts (command documentors) to use.
"
}]
proc strip_nodisplay_comments {text} {
set display ""
foreach ln [split $text \n] {
if {![string match "#<nodisplay>*" [string trimleft [punk::ansi::ansistrip $ln]]]} {
append display $ln \n
}
}
if {[string index $display end] eq "\n"} {
set display [string range $display 0 end-1]
}
return $display
}
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Base namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
@ -624,8 +783,15 @@ tcl::namespace::eval punk::args {
-maxsize (type dependant)
-range (type dependant - only valid if -type is a single item)
-typeranges (list with same number of elements as -type)
-help <string>
for the @cmd directive - this is the main multiline description.
For an argument is the multi-line help that displays in the Help
column.
For the @examples directive this is the text for examples as
displayed with 'eg <commandname>'
For cases where unbalanced braces, double quotes are to
be displayed to the user without visible backslash escapes,
see 'i ::punk::args::helpers::strip_nodisplay_comments'
"
-dynamic -type boolean -default 0 -help\
"If -dynamic is true, tstr interpolations of the form \$\{\$var\}
@ -649,7 +815,7 @@ tcl::namespace::eval punk::args {
from existing definitions (by id) for re-use of argument specifications and help text)
e.g the following definition passes 2 blocks as text arguments
${[punk::args::moduledoc::tclcore::argdoc ::example {
${[punk::args::helpers ::example {
punk::args::define {
@id -id ::myns::myfunc
@cmd -name myns::myfunc -help\
@ -955,6 +1121,8 @@ tcl::namespace::eval punk::args {
set LVL 2
if {!$is_dynamic} {
#todo - don't use cached version if 'colour off' vs 'colour on' different to when last resolved!
#(e.g example blocks will still have colour if previously resolved)
if {[tcl::dict::exists $argdata_cache $cache_key]} {
return [tcl::dict::get $argdata_cache $cache_key]
}
@ -1082,6 +1250,19 @@ tcl::namespace::eval punk::args {
set record_line 0 ;#incremented at each incomplete record, set to zero after processing a complete record
foreach rawline $linelist {
#puts stderr "$record_line $rawline"
#XXX
#set rawtrimmed [string trim $rawline]
#if {$in_record_continuation && $rawtrimmed ne "" && [string index $rawtrimmed 0] ni [list "\}" {"} "#"]} {
# regexp {(\s*).*} $rawline _ rawline_indent
# if {[string length $rawline_indent] <= [string length $record_base_indent]} {
# lappend records $linebuild
# set linebuild ""
# #prep for next record
# set in_record_continuation 0
# incr record_id
# set record_line 0
# }
#}
set record_so_far [tcl::string::cat $linebuild $rawline]
#ansi colours can stop info complete from working (contain square brackets)
#review - when exactly are ansi codes allowed/expected in record lines.
@ -1174,6 +1355,10 @@ tcl::namespace::eval punk::args {
set record_line 0
}
}
if {$in_record_continuation} {
puts stderr "punk::args::resolve incomplete record:"
puts stderr "$linebuild"
}
#puts stderr 1[lindex $records 1]
#puts stderr 4[lindex $records 4]
#puts stderr 5[lindex $records 5]
@ -1212,6 +1397,13 @@ tcl::namespace::eval punk::args {
"" - # {continue}
}
incr record_number
if {[catch {lassign $trimrec firstword}]} {
puts stdout "----------------------------------------------"
puts stderr "rec: $rec"
set ::testrecord $rec
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
if {[llength $record_values] % 2 != 0} {
#todo - avoid raising an error - store invalid defs keyed on id
@ -3671,6 +3863,7 @@ tcl::namespace::eval punk::args {
lappend blank_header_col ""
#set cmdhelp_display [a+ brightwhite]$cmdhelp[a]
#set cmdhelp_display [textblock::ansibase_lines $cmdhelp $CLR(linebase_header)]
set cmdhelp [punk::args::helpers::strip_nodisplay_comments $cmdhelp]
set cmdhelp_display [punk::ansi::ansiwrap_raw $CLR(linebase_header) "" "" $cmdhelp]
} else {
set cmdhelp_display ""
@ -4055,6 +4248,7 @@ tcl::namespace::eval punk::args {
}
set unindentedfields [Dict_getdef $arginfo -unindentedfields {}]
set help [Dict_getdef $arginfo -help ""]
set help [punk::args::helpers::strip_nodisplay_comments $help]
set allchoices_originalcase [list]
set choices [Dict_getdef $arginfo -choices {}]
set choicegroups [Dict_getdef $arginfo -choicegroups {}]
@ -4656,7 +4850,7 @@ tcl::namespace::eval punk::args {
lappend PUNKARGS [list {
@id -id ::punk::args::parse
@cmd -name punk::args::parse -help\
" parse and validate command arguments based on a definition.
{ parse and validate command arguments based on a definition.
In the 'withid' form the definition is a pre-existing record that has been
created with ::punk::args::define, or indirectly by adding a definition to
@ -4673,23 +4867,25 @@ tcl::namespace::eval punk::args {
Returns a dict of information regarding the parsed arguments
example of basic usage for single option only:
punk::args::define {
@id -id ::myns::myfunc
@cmd -name myns::myfunc
@leaders -min 0 -max 0
@opts
-configfile -type existingfile
#type none makes it a solo flag
-verbose -type none
@values -min 0 -max 0
}
proc myfunc {args} {
set argd [punk::args::parse $args withid ::myns::myfunc]
lassign [dict values $argd] leaders opts values received solos
if {[dict exists $received] -configfile} {
puts \"have option for existing file [dict get $opts -configfile]\"
}
}
${[punk::args::helpers::example {
punk::args::define {
@id -id ::myns::myfunc
@cmd -name myns::myfunc
@leaders -min 0 -max 0
@opts
-configfile -type existingfile
#type none makes it a solo flag
-verbose -type none
@values -min 0 -max 0
}
proc myfunc {args} {
set argd [punk::args::parse $args withid ::myns::myfunc]
lassign [dict values $argd] leaders opts values received solos
if {[dict exists $received] -configfile} {
puts "have option for existing file [dict get $opts -configfile]"
}
}
}]}
The leaders, opts, values keys in the parse result dict are proper dicts.
The received key is dict-like but can have repeated keys for arguments than can
accept multiples. The value for each received element is the ordinal position.
@ -4698,7 +4894,7 @@ tcl::namespace::eval punk::args {
to another procedure which also requires solos, because the opts dict contains
solo flags with a 1 value or a list of 1's if it was a solo with -multiple true
specified.
"
}
@form -form {withid withdef}
@leaders -min 1 -max 1
arglist -type list -optional 0 -help\
@ -9152,7 +9348,8 @@ tcl::namespace::eval punk::args {
return
}
if {[dict exists $spec examples_info -help]} {
return [dict get $spec examples_info -help]
set egdata [dict get $spec examples_info -help]
return [punk::args::helpers::strip_nodisplay_comments $egdata]
} else {
return "no @examples defined for $id"
}
@ -10807,7 +11004,7 @@ tcl::namespace::eval punk::args::package {
# set PUNKARGS ""
#}
lappend ::punk::args::register::NAMESPACES ::punk::args::argdoc ::punk::args ::punk::args::lib ::punk::args::package
lappend ::punk::args::register::NAMESPACES ::punk::args::argdoc ::punk::args ::punk::args::lib ::punk::args::package ::punk::args::helpers
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
