jn
/
punkshell
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
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
b152ea9775
commit
0a2ad0229e
7 changed files with 1388 additions and 345 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 5
      src/modules/punk/ansi-999999.0a1.0.tm
  2. 158
      src/modules/punk/args-999999.0a1.0.tm
  3. 1445
      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. 44
      src/modules/punk/ns-999999.0a1.0.tm
  7. 3
      src/modules/textblock-999999.0a1.0.tm

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

@ -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

158
src/modules/punk/args-999999.0a1.0.tm
Unescape View File

@ -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
}
@ -9640,7 +9736,8 @@ tcl::namespace::eval punk::args {
dict for {g members} $opt_groupdict {
lappend allgrouped {*}$members
}
set choiceinfodict [dict create]
set choiceinfodict [dict create]
set choicelabelsdict [dict create]
foreach {sc cmd} $subdict {
if {$sc ni $allgrouped} {
if {$sc ni $others} {
@ -9669,20 +9766,43 @@ 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]]} {
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]"
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 {*}$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..

1445
src/modules/punk/args/moduledoc/tclcore-999999.0a1.0.tm
View File

File diff suppressed because it is too large Load Diff

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

@ -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
Unescape View File

@ -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.

44
src/modules/punk/ns-999999.0a1.0.tm
Unescape View File

@ -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,12 +4685,10 @@ 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]
}
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
}
@ -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
}

3
src/modules/textblock-999999.0a1.0.tm
Unescape View File

@ -7989,13 +7989,14 @@ 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}>}\
-choices {${[textblock::frametypes]}}\
-choicerestricted 0 -choicecolumns 8\
-choicelabels {
${[textblock::frame_samples]}
${[textblock::frame_samples]}
}\
-help "Type of border for frame."
-boxlimits -default {hl vl tlc blc trc brc} -type list -help "Limit the border box to listed elements.

Write Preview
Loading…
Cancel
Save