Browse Source

fixes for punk::args and punk::ns ensemble-handling and new arg types packageversion & packagerequirement, punk::args::moduledoc::tclcore - more core tcl documentation

master
Julian Noble 2 months ago
parent
commit
0a2ad0229e
  1. 5
      src/modules/punk/ansi-999999.0a1.0.tm
  2. 154
      src/modules/punk/args-999999.0a1.0.tm
  3. 959
      src/modules/punk/args/moduledoc/tclcore-999999.0a1.0.tm
  4. 70
      src/modules/punk/args/moduledoc/tkcore-999999.0a1.0.tm
  5. 2
      src/modules/punk/mix/commandset/module-999999.0a1.0.tm
  6. 36
      src/modules/punk/ns-999999.0a1.0.tm
  7. 1
      src/modules/textblock-999999.0a1.0.tm

5
src/modules/punk/ansi-999999.0a1.0.tm

@ -5835,8 +5835,11 @@ tcl::namespace::eval punk::ansi::ta {
#*** !doctools
#[subsection {Namespace punk::ansi::ta}]
#[para] text ansi functions
#[para] based on but not identical to the Perl Text Ansi module:
#[para] based on the API but not identical to the Perl Text Ansi module: Text::ANSI::Util
#[para] https://metacpan.org/pod/Text::ANSI::Util
#[para] https://github.com/perlancar/perl-Text-ANSI-Util/blob/master/lib/Text/ANSI/BaseUtil.pm
#[para] These functions are not based on the source code of the perl functions, but the documented input and output
#[para] so algorithms and performance may differ.
#[list_begin definitions]
tcl::namespace::path ::punk::ansi
namespace export detect detect_in_list detect_sgr extract length split_codes split_at_codes split_codes_single

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

@ -979,7 +979,9 @@ tcl::namespace::eval punk::args {
# -arg -choices {${$DYN_CHOICES}} -help "${$RED}important info${$RST}"
#}
if {$defspace ne ""} {
set optionspecs [namespace eval $defspace [list punk::args::lib::tstr -return string -eval 1 -allowcommands $optionspecs]]
#set optionspecs [namespace eval $defspace [list punk::args::lib::tstr -return string -eval 1 -allowcommands $optionspecs]]
#JJJ - review
set optionspecs [namespace eval $defspace [list punk::args::lib::tstr -return string -eval 1 -allowcommands -paramindents none $optionspecs]]
}
#REVIEW - join also serves to unescape things such as \$\{$x\} \$\{[cmd]\} without subst'ing or evaling (?)
if {[string first \$\{ $optionspecs] > 0} {
@ -2017,6 +2019,8 @@ tcl::namespace::eval punk::args {
}
ansi - ansistring {set normtype ansistring}
string - globstring {set normtype $lc_firstword}
packageversion {set normtype packageversion}
packagerequirement {set normtype packagerequirement}
literal {
#value was split out by _split_type_expression
set normtype literal([lindex $alt 1])
@ -2390,8 +2394,13 @@ tcl::namespace::eval punk::args {
as these arguments are already fully spec'd. The defaults from the
source can be removed by adding @leaders, @opts @values to the
-antiglobs list, but again - this won't affect the existing arguments.
Each argument can have members of its spec overridden using the
-override dictionary.
-override dictionary The members of each override sub dictionary are
usually options beginning with a dash. The key 'name' can be used to
override the name of the leader/option/value itself.
e.g
punk::args::resolved_def -types values -override {version {name version1 -optional 0}} (shared)::package version
"
@leaders -min 0 -max 0
@opts
@ -2608,8 +2617,9 @@ tcl::namespace::eval punk::args {
if {[dict get $argspec -ARGTYPE] eq $tp} {
set argspec [dict remove $argspec -ARGTYPE]
if {[dict exists $opt_override $m]} {
append result \n "\"$m\" [dict merge $argspec [dict get $opt_override $m]]"
dict set resultdict $m [dict merge $argspec [dict get $opt_override $m]]
set overdict [dict get $opt_override $m]
append result \n "\"$m\" [dict merge $argspec $overdict]"
dict set resultdict $m [dict merge $argspec $overdict]
} else {
append result \n "\"$m\" $argspec"
dict set resultdict $m $argspec
@ -2670,8 +2680,19 @@ tcl::namespace::eval punk::args {
if {[dict get $argspec -ARGTYPE] eq [dict get $argtypes $type]} {
set argspec [dict remove $argspec -ARGTYPE]
if {[dict exists $opt_override $m]} {
append result \n "\"$m\" [dict merge $argspec [dict get $opt_override $m]]"
dict set resultdict $m [dict merge $argspec [dict get $opt_override $m]]
set overdict [dict get $opt_override $m]
if {[dict exists $opt_override $m name]} {
#special override for name of argument itself
#e.g
#punk::args::resolved_def -types values -override {version {name version1 -optional 1}} (shared)::package version
set newname [dict get $opt_override $m name]
dict unset overdict name
append result \n "\"$newname\" [dict merge $argspec $overdict]"
dict set resultdict $newname [dict merge $argspec $overdict]
} else {
append result \n "\"$m\" [dict merge $argspec $overdict]"
dict set resultdict $m [dict merge $argspec $overdict]
}
} else {
append result \n "\"$m\" $argspec"
dict set resultdict $m $argspec
@ -3501,6 +3522,9 @@ tcl::namespace::eval punk::args {
set docname [Dict_getdef $spec_dict doc_info -name "Manual:"]
set docurl [Dict_getdef $spec_dict doc_info -url ""]
#set example [Dict_getdef $spec_dict examples_info -help ""]
set has_example [dict exists $spec_dict examples_info -help]
#review - when can there be more than one selected form?
set argdisplay_header ""
set argdisplay_body ""
@ -3546,6 +3570,12 @@ tcl::namespace::eval punk::args {
} else {
set docurl_display ""
}
if {$has_example} {
lappend blank_header_col ""
set example_display "[a+ white]eg [dict get $spec_dict id]$RST"
} else {
set example_display ""
}
#synopsis
set synopsis "# [Dict_getdef $spec_dict cmd_info -summary {}]\n"
set form_info [dict get $spec_dict form_info]
@ -3624,6 +3654,14 @@ tcl::namespace::eval punk::args {
}
incr h
}
if {$has_example} {
if {$use_table} {
$t configure_header $h -colspans $arg_colspans -values [list Example: $example_display]
} else {
lappend errlines "Example: $docurl_display"
}
incr h
}
if {$synopsis ne ""} {
if {$use_table} {
$t configure_header $h -colspans $arg_colspans -values [list Synopsis: [punk::ansi::ansiwrap brightwhite $synopsis]]
@ -5807,6 +5845,49 @@ tcl::namespace::eval punk::args {
break
}
}
packageversion {
if {[catch {::package vsatisfies $e_check $e_check}]} {
set msg "$argclass $argname for %caller% requires type packageversion. A package version number as understood by 'package vsatifies'. Received: '$e_check'"
lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs] msg $msg]
} else {
lset clause_results $c_idx $a_idx 1
break
}
}
packagerequirement {
set parts [split $e_check -]
if {[llength $parts] > 2} {
set msg "$argclass $argname for %caller% requires type packagerequirement. (form min min- or min-max) Received: '$e_check'"
lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs] msg $msg]
continue
}
set vchecklist [list]
if {[llength $parts] == 1} {
lappend vchecklist [lindex $parts 0]
} else {
lassign $parts vmin vmax
if {$vmax eq ""} {
#empty vmax allowed - ignore
lappend vchecklist $vmin
} else {
lappend vchecklist $vmin $vmax
}
}
#we have either just the min, or min and max
set v_ok 1 ;#default assumption
foreach vcheck $vchecklist {
if {[catch {::package vsatisfies $vcheck $vcheck}]} {
set msg "$argclass $argname for %caller% requires type packagerequirement. (from min min- or min-max) . Received: '$e_check'"
lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs] msg $msg]
set v_ok 0
break ;#inner loop
}
}
if {$v_ok} {
lset clause_results $c_idx $a_idx 1
break
}
}
string - ansistring - globstring {
#we may commonly want exceptions that ignore validation rules - most commonly probably the empty string
#we possibly don't want to always have to regex on things that don't pass the other more basic checks
@ -9167,6 +9248,7 @@ tcl::namespace::eval punk::args {
append syn " $display"
dict set ARGD type [dict get $arginfo -type]
dict set ARGD optional [dict get $arginfo -optional]
dict set ARGD multiple [dict get $arginfo -multiple]
dict set ARGD display $display
#dict lappend SYND $f $ARGD
@ -9300,6 +9382,7 @@ tcl::namespace::eval punk::args {
append syn " $display"
dict set ARGD type [dict get $arginfo -type]
dict set ARGD optional [dict get $arginfo -optional]
dict set ARGD multiple [dict get $arginfo -multiple]
dict set ARGD display $display
#dict lappend SYND $f $ARGD
lappend FORMARGS $ARGD
@ -9417,10 +9500,23 @@ tcl::namespace::eval punk::args {
append syn " $display"
dict set ARGD type [dict get $arginfo -type]
dict set ARGD optional [dict get $arginfo -optional]
dict set ARGD multiple [dict get $arginfo -multiple]
dict set ARGD display $display
#dict lappend SYND $f $ARGD
lappend FORMARGS $ARGD
}
#accepts unnamed extra arguments e.g toplevel docid for ensembles and ensemble-like commands
if {[dict get $forminfo VAL_UNNAMED]} {
set display "?<unnamed>...?"
append syn " $display"
set ARGD [dict create argname "" class value]
dict set ARGD type any
dict set ARGD optional 1
dict set ARGD multiple 1
dict set ARGD display $display
lappend FORMARGS $ARGD
}
append syn \n
dict set SYND FORMS $f $FORMARGS
}
@ -9641,6 +9737,7 @@ tcl::namespace::eval punk::args {
lappend allgrouped {*}$members
}
set choiceinfodict [dict create]
set choicelabelsdict [dict create]
foreach {sc cmd} $subdict {
if {$sc ni $allgrouped} {
if {$sc ni $others} {
@ -9669,19 +9766,42 @@ tcl::namespace::eval punk::args {
}
}
#could be more than one punk::args id - choose a precedence by how we order the id_exists checks.
if {[punk::args::id_exists [list $ensemble $sc]]} {
dict lappend choiceinfodict $sc {doctype punkargs}
dict lappend choiceinfodict $sc [list subhelp {*}$ensemble $sc]
} elseif {[punk::args::id_exists $cmd]} {
dict lappend choiceinfodict $sc {doctype punkargs}
dict lappend choiceinfodict $sc [list subhelp {*}$cmd]
} elseif {[punk::args::id_exists [dict get $cinfo origin]]} {
set id_checks [list\
"$ensemble $sc"\
$cmd\
[dict get $cinfo origin]\
]
foreach checkid $id_checks {
if {[punk::args::id_exists $checkid]} {
dict lappend choiceinfodict $sc {doctype punkargs}
dict lappend choiceinfodict $sc [list subhelp {*}[dict get $cinfo origin]]
} else {
#puts stderr "ensemble_subcommands_definition--- NO doc for [list $ensemble $sc] or $cmd or [dict get $cinfo origin]"
dict lappend choiceinfodict $sc [list subhelp {*}$checkid]
dict set choicelabelsdict $sc [punk::ansi::a+ normal][punk::ns::synopsis $checkid][punk::ansi::a]
break
}
}
#if {[punk::args::id_exists [list $ensemble $sc]]} {
# dict lappend choiceinfodict $sc {doctype punkargs}
# dict lappend choiceinfodict $sc [list subhelp {*}$ensemble $sc]
#} elseif {[punk::args::id_exists $cmd]} {
# dict lappend choiceinfodict $sc {doctype punkargs}
# dict lappend choiceinfodict $sc [list subhelp {*}$cmd]
#} elseif {[punk::args::id_exists [dict get $cinfo origin]]} {
# dict lappend choiceinfodict $sc {doctype punkargs}
# dict lappend choiceinfodict $sc [list subhelp {*}[dict get $cinfo origin]]
#}
#foreach id [punk::args::get_ids "::package *"] {
# if {[llength $id] == 2} {
# lassign $id _ sub
# dict set PACKAGE_CHOICEINFO $sub {{doctype native} {doctype punkargs}}
# #override manual synopsis entry
# dict set PACKAGE_CHOICELABELS $sub [punk::ns::synopsis "::package $sub"]
# }
#}
#if {[punk::args::id_exists [dict get $cinfo origin]] || [punk::args::id_exists [list $ensemble $sc]]} {
# dict lappend choiceinfodict $sc {doctype punkargs}
@ -9694,7 +9814,7 @@ tcl::namespace::eval punk::args {
dict for {g members} $opt_groupdict {
append argdef " \"$g\" \{$members\}" \n
}
append argdef " \} -choicecolumns $opt_columns -choiceinfo {$choiceinfodict}" \n
append argdef " \} -choicecolumns $opt_columns -choicelabels {$choicelabelsdict} -choiceinfo {$choiceinfodict}" \n
#todo -choicelabels
#detect subcommand further info available e.g if oo or ensemble or punk::args id exists..

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

File diff suppressed because it is too large Load Diff

70
src/modules/punk/args/moduledoc/tkcore-999999.0a1.0.tm

@ -453,7 +453,75 @@ tcl::namespace::eval punk::args::moduledoc::tkcore {
} "@doc -name Manpage: -url [manpage bell]"
} "@doc -name Manpage: -url [manpage button]"\
{@examples -help {
This is the classic Tk “Hello, World!” demonstration:
${[punk::args::moduledoc::tclcore::argdoc::example {
button .b -text "Hello, World!" -command exit
pack .b
}]}
This example demonstrates how to handle button accelerators:
${[punk::args::moduledoc::tclcore::argdoc::example {
button .b1 -text Hello -underline 0
button .b2 -text World -underline 0
bind . <Key-h> {.b1 flash; .b1 invoke}
bind . <Key-w> {.b2 flash; .b2 invoke}
pack .b1 .b2
}]}
}
}
punk::args::define {
@id -id "(widgetcommand)Class_Button cget"
@cmd -name "(widgetcommand)Class_Button cget" -help\
"Returns the current value of the configuration option given by option.
Option may have any of the values accepted by the button command."
@leaders -min 1 -max 1
option -type string
}
set CLASS_BUTTON_CHOICES [list cget configure flash invoke]
#manual synopses for subcommands not yet defined
set CLASS_BUTTON_CHOICELABELS [subst -novariables {
}]
set CLASS_BUTTON_CHOICEINFO [dict create]
foreach sub $CLASS_BUTTON_CHOICES {
#default for all
dict set CLASS_BUTTON_CHOICEINFO $sub {{doctype native}}
}
foreach id [punk::args::get_ids "(widgetcommand)Class_Button *"] {
if {[llength $id] == 2} {
lassign $id _ sub
dict set CLASS_BUTTON_CHOICEINFO $sub {{doctype native} {doctype punkargs}}
#override manual synopsis entry
#puts stderr "override manual synopsis entry with [punk::ns::synopsis "::package $sub"]"
dict set CLASS_BUTTON_CHOICELABELS $sub [punk::ansi::a+ normal][punk::ns::synopsis "(widgetcommand)Class_Button $sub"]
}
}
punk::args::define {
@id -id (widgetcommand)Class_Button
@cmd -name "Tk widget: (widgetcommand)Class_Button"\
-summary\
"widgetcommand for Tk class Button"\
-help\
"widgetcommand for Tk class Button"
@leaders -min 1 -max 1
option -type string\
-choicecolumns 2\
-choicegroups {
"actions" {flash invoke}
}\
-choicelabels {${$CLASS_BUTTON_CHOICELABELS}}\
-choiceinfo {${$CLASS_BUTTON_CHOICEINFO}}
} "@doc -name Manpage: -url [manpage button]"
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---

2
src/modules/punk/mix/commandset/module-999999.0a1.0.tm

@ -151,7 +151,7 @@ namespace eval punk::mix::commandset::module {
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 -type packageversion -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.

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

@ -2984,7 +2984,7 @@ tcl::namespace::eval punk::ns {
switch -- $generaltype {
method - private {
#private? todo?
if {$location eq $origin} {
if {$location eq "object" || $location eq $origin} {
#set id "[string trimleft $origin :] $cmd" ;# "<object> <method>"
set id "$origin $cmd"
#dict set choiceinfodict $cmd {{doctype ooo}}
@ -3183,17 +3183,18 @@ tcl::namespace::eval punk::ns {
@cmd -help\
"(autogenerated by generate_autodef)
ensemble: ${$origin}"
@leaders -min 1
}]
#we must put a max on @leaders so that any subsequent arguments are not parsed as leaders for an ensemble root docid
if {[llength $parameters] == 0} {
append argdef \n "@leaders -min 1"
append argdef \n "@leaders -min 1 -max 1"
} else {
append argdef \n "@leaders -min [expr {[llength $parameters]+1}]"
append argdef \n "@leaders -min [expr {[llength $parameters]+1}] -max [expr {[llength $parameters]+1}]"
foreach p $parameters {
append argdef \n "$p -type string -help { (leading ensemble parameter)}"
}
}
append argdef \n $vline
append argdef \n "@values -unnamed true"
punk::args::define $argdef
}
proc {
@ -3504,7 +3505,7 @@ tcl::namespace::eval punk::ns {
set origin [list $origin $a]
incr i
set queryargs [lrange $args $i end]
set resolvedargs [list $a] ;#even though the
set resolvedargs [list $a] ;#
set queryargs_untested $queryargs
} elseif {[punk::args::id_exists $docid]} {
set docid_exists 1
@ -3700,8 +3701,10 @@ tcl::namespace::eval punk::ns {
set origin [yield [list 0 $mapped_subcmd $resolvedargs $queryargs_untested $docid]]
#set resolvedargs [list]
incr i [expr {-1 * [llength $resolvedargs]+1}]
#puts stderr "... yield-result $origin i:$i"
#incr i [expr {-1 * [llength $resolvedargs]+1}] ;#wrong e.g test trace add execution blah enterstep cmd
#JJJ
#puts stderr "... yield-result $origin i:$i args: $args"
set whichinfo [namespace eval $ns [list punk::ns::cmdwhich $origin]]
set origin [dict get $whichinfo origin]
@ -3719,12 +3722,12 @@ tcl::namespace::eval punk::ns {
set docid ""
}
break
break ;#out of foreach q $queryargs ...
} else {
#test with: i namespace which -v x
return [list 7 $origin $resolvedargs $queryargs_untested $prevdocid]
}
}
} ;#end loop foreach q $queryargs lname $leadernames_matched
} else {
#??
puts stderr "cmdinfo.cmd_traverse returning 8 $origin $resolvedargs [lrange $args $i end] $docid"
@ -3758,7 +3761,8 @@ tcl::namespace::eval punk::ns {
set argd [::punk::args::parse $args withid ::punk::ns::forms]
set cmdwords [dict get $argd values cmditem]
set resolveinfo [uplevel 1 [list ::punk::ns::cmdinfo {*}$cmdwords]] ;#resolve from calling context
set id [dict get $resolveinfo origin]
#set id [dict get $resolveinfo origin]
set id [dict get $resolveinfo docid]
::punk::args::forms $id
}
@ -3778,8 +3782,10 @@ tcl::namespace::eval punk::ns {
set argd [::punk::args::parse $args withid ::punk::ns::eg]
set cmdwords [dict get $argd values cmditem]
set resolveinfo [uplevel 1 [list ::punk::ns::cmdinfo {*}$cmdwords]] ;#resolve from calling context
set resolved_id [dict get $resolveinfo origin]
set result [::punk::args::eg $resolved_id]
#set resolved_id [dict get $resolveinfo origin]
#set result [::punk::args::eg $resolved_id]
set docid [dict get $resolveinfo docid]
set result [::punk::args::eg $docid]
}
@ -4663,7 +4669,7 @@ tcl::namespace::eval punk::ns {
lassign $impl generaltype mname location methodtype
switch -- $generaltype {
method - private {
if {$location eq $origin} {
if {$location eq "object" || $location eq $origin} {
#set id "[string trimleft $origin :] $cmd" ;# "<object> <method>"
set id "$origin $cmd"
dict set choiceinfodict $cmd {{doctype objectmethod}}
@ -4679,13 +4685,11 @@ tcl::namespace::eval punk::ns {
dict lappend choiceinfodict $cmd [list doctype [list $location $methodtype]]
}
}
if {[info commands ::punk::args::id_exists] ne ""} {
if {[punk::args::id_exists $id]} {
#dict set choicelabeldict $cmd " [Usageinfo_mark brightgreen]"
dict lappend choiceinfodict $cmd {doctype punkargs}
dict lappend choiceinfodict $cmd [list subhelp {*}$id]
}
}
break
}
filter {
@ -4842,7 +4846,6 @@ tcl::namespace::eval punk::ns {
@cmd -help\
"(autogenerated by arginfo)
ensemble: ${$origin}"
@leaders -min 1
}]
if {[llength $parameters] == 0} {
append argdef \n "@leaders -min 1"
@ -4852,6 +4855,7 @@ tcl::namespace::eval punk::ns {
append argdef \n "$p -type string -help { (leading ensemble parameter)}"
}
}
append argdef \n "@values -unnamed true"
append argdef \n $vline
punk::args::define $argdef
}

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

@ -7989,6 +7989,7 @@ tcl::namespace::eval textblock {
Set false for performance improvement."
-etabs -default 0\
-help "expanding tabs - experimental/unimplemented."
#review - -choicelabels placeholder dollarsign of textblock::frame_samples must be left aligned with -choicelabels
-type -default light\
-type dict\
-typesynopsis {${$I}choice${$NI}|<${$I}dict${$NI}>}\

Loading…
Cancel
Save