Browse Source

punk::args minor doc fixes, update bootsupport and vfs

master
Julian Noble 1 week ago
parent
commit
7e50ef88f0
  1. 6653
      src/bootsupport/modules/punk/args-0.1.8.tm
  2. 32
      src/modules/punk/args-999999.0a1.0.tm
  3. 6
      src/modules/punk/args/tzint-999999.0a1.0.tm
  4. 4
      src/project_layouts/custom/_project/punk.basic/src/make.tcl
  5. 6653
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.1.8.tm
  6. 4
      src/project_layouts/custom/_project/punk.project-0.1/src/make.tcl
  7. 6653
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.1.8.tm
  8. 4
      src/project_layouts/custom/_project/punk.shell-0.1/src/make.tcl
  9. 110
      src/vfs/_vfscommon.vfs/modules/punk/args-0.1.7.tm
  10. 6653
      src/vfs/_vfscommon.vfs/modules/punk/args-0.1.8.tm
  11. 6
      src/vfs/_vfscommon.vfs/modules/punk/args/tclcore-0.1.0.tm
  12. 309
      src/vfs/_vfscommon.vfs/modules/punk/args/tzint-1.1.1.tm
  13. BIN
      src/vfs/_vfscommon.vfs/modules/test/punk/args-0.1.5.tm

6653
src/bootsupport/modules/punk/args-0.1.8.tm

File diff suppressed because it is too large Load Diff

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

@ -554,7 +554,11 @@ tcl::namespace::eval punk::args {
\"Description of command\"
#The following option defines an option-value pair
-option1 -default blah -type string
#It may have aliases by separating them with a pipe |
-fg|-foreground -default blah -type string -help\\
\"In the result dict returned by punk::args::parse
the value used in the opts key will always be the last
entry, in this case -foreground\"
#The following option defines a flag style option (solo)
-flag1 -default 0 -type none -help\\
\"Info about flag1
@ -4097,7 +4101,17 @@ tcl::namespace::eval punk::args {
set pre_values {}
set argnames [tcl::dict::keys $ARG_INFO]
set optnames [lsearch -all -inline $argnames -*]
#set optnames [lsearch -all -inline $argnames -*]
#JJJ
set all_opts [list]
set lookup_optset [dict create]
foreach optset $OPT_NAMES {
set optmembers [split $optset |]
lappend all_opts {*}$optmembers
foreach opt $optmembers {
dict set lookup_optset $opt $optset
}
}
set ridx 0
set rawargs_copy $rawargs
set remaining_rawargs $rawargs
@ -4139,7 +4153,7 @@ tcl::namespace::eval punk::args {
#argument such as a dictionary may have leading dash - test for whitespace to exclude as possible option
if {[tcl::string::match -* $r] && !([tcl::string::first " " $r]>=0 || [tcl::string::first \t $r]>=0 || [tcl::string::last \n $r]>=0)} {
set matchopt [::tcl::prefix::match -error {} $optnames $r]
set matchopt [::tcl::prefix::match -error {} $all_opts $r]
if {$matchopt ne ""} {
#flaglike matches a known flag - don't treat as leader
break
@ -4273,7 +4287,6 @@ tcl::namespace::eval punk::args {
set argstate $ARG_INFO ;#argstate may have entries added
set arg_checks $ARG_CHECKS
#JJJJ
if {$LEADER_MIN eq ""} {
set leadermin 0
} else {
@ -4295,16 +4308,7 @@ tcl::namespace::eval punk::args {
#assert - remaining_rawargs has been reduced by leading positionals
set opts [dict create] ;#don't set to OPT_DEFAULTS here
set all_opts [list]
set lookup_optset [dict create]
foreach optset $OPT_NAMES {
set optmembers [split $optset |]
lappend all_opts {*}$optmembers
foreach opt $optmembers {
dict set lookup_optset $opt $optset
}
}
#JJJ
set leaders [list]
set arglist {}

6
src/modules/punk/args/tzint-999999.0a1.0.tm

@ -114,8 +114,10 @@ tcl::namespace::eval punk::args::tzint {
@dynamic
@id -id "::tzint::Encode svg"
@cmd -name "native tzint::Encode svg"
@leaders -min 0 -max 2
"varName data" -type {string string} -optional 1
@leaders -min 2 -max 2
#review - error msg for Encode without args is "Encode command ?name|varName data? ?-option value ...?
#This implies "varName data" is optional - but in practice it seems not to be (?)
"varName data" -type {string string} -optional 0
@opts
-symbology -type string -choicerestricted 0 -choices {${[::punk::args::tzint::argdoc::get_symbologies]}}
-height -type integer -help\

4
src/project_layouts/custom/_project/punk.basic/src/make.tcl

@ -2044,10 +2044,6 @@ if {[file exists $mapfile]} {
}
# -- --- --- --- --- --- --- --- --- ---
puts "-- runtime_vfs_map --"
set ver [package require punk::args]
puts "punk::args ver: $ver"
set ifneeded [package ifneeded punk::args $ver]
puts "punk::args ifneeded: $ifneeded"
punk::lib::pdict runtime_vfs_map
puts "---------------------"
puts "-- vfs_runtime_map--"

6653
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.1.8.tm

File diff suppressed because it is too large Load Diff

4
src/project_layouts/custom/_project/punk.project-0.1/src/make.tcl

@ -2044,10 +2044,6 @@ if {[file exists $mapfile]} {
}
# -- --- --- --- --- --- --- --- --- ---
puts "-- runtime_vfs_map --"
set ver [package require punk::args]
puts "punk::args ver: $ver"
set ifneeded [package ifneeded punk::args $ver]
puts "punk::args ifneeded: $ifneeded"
punk::lib::pdict runtime_vfs_map
puts "---------------------"
puts "-- vfs_runtime_map--"

6653
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.1.8.tm

File diff suppressed because it is too large Load Diff

4
src/project_layouts/custom/_project/punk.shell-0.1/src/make.tcl

@ -2044,10 +2044,6 @@ if {[file exists $mapfile]} {
}
# -- --- --- --- --- --- --- --- --- ---
puts "-- runtime_vfs_map --"
set ver [package require punk::args]
puts "punk::args ver: $ver"
set ifneeded [package ifneeded punk::args $ver]
puts "punk::args ifneeded: $ifneeded"
punk::lib::pdict runtime_vfs_map
puts "---------------------"
puts "-- vfs_runtime_map--"

110
src/vfs/_vfscommon.vfs/modules/punk/args-0.1.7.tm

@ -4096,7 +4096,9 @@ tcl::namespace::eval punk::args {
if {$leader_posn_name ne ""} {
#there is a named leading positional for this position
#The flaglooking value doesn't match an option - so treat as a leader
foreach v $leader_posn_name {
lappend pre_values [lpop rawargs 0]
}
dict incr leader_posn_names_assigned $leader_posn_name
incr ridx
continue
@ -4107,6 +4109,7 @@ tcl::namespace::eval punk::args {
#for each branch - break or lappend
if {$leader_posn_name ne ""} {
set stridelength [llength $leader_posn_name]
if {$leader_posn_name ni $LEADER_REQUIRED} {
#optional leader
@ -4126,22 +4129,27 @@ tcl::namespace::eval punk::args {
#}
#check if enough rawargs to fill any required values
if {$VAL_MIN > 0 && [llength $rawargs] <= $VAL_MIN || [llength $rawargs] <= [llength $VAL_REQUIRED]} {
if {$VAL_MIN > 0 && [llength $rawargs] - $stridelength <= $VAL_MIN || [llength $rawargs] - $stridelength <= [llength $VAL_REQUIRED]} {
break
} else {
#leadername may be a 'stride' of arbitrary length (e.g {"key val"} or {"key val etc"})
foreach v {$leader_posn_name} {
lappend pre_values [lpop rawargs 0]
}
dict incr leader_posn_names_assigned $leader_posn_name
}
} else {
#required
if {[dict exists $leader_posn_names_assigned $leader_posn_name]} {
#already accepted at least one value - requirement satisfied - now equivalent to optional
if {$VAL_MIN > 0 && [llength $rawargs] <= $VAL_MIN || [llength $rawargs] <= [llength $VAL_REQUIRED]} {
if {$VAL_MIN > 0 && [llength $rawargs] - $stridelength <= $VAL_MIN || [llength $rawargs] - $stridelength <= [llength $VAL_REQUIRED]} {
break
}
}
#if we didn't break - requirement is not yet satisfied, or is satisfied but stil enough rawargs for required values
foreach v {$leader_posn_name} {
lappend pre_values [lpop rawargs 0]
}
dict incr leader_posn_names_assigned $leader_posn_name
}
} else {
@ -4425,8 +4433,7 @@ tcl::namespace::eval punk::args {
set positionalidx 0 ;#index for unnamed positionals (both leaders and values)
set ldridx 0
set in_multiple ""
set leadername_multiple ""
set leadernames_received [list]
set num_leaders [llength $leaders]
@ -4439,26 +4446,60 @@ tcl::namespace::eval punk::args {
set leaders_dict [dict merge $leaders_dict $LEADER_DEFAULTS]
#----------------------------------------
foreach leadername $LEADER_NAMES ldr $leaders {
if {$ldridx+1 > $num_leaders} {
break
}
set start_position $positionalidx
set nameidx 0
#MAINTENANCE - same loop logic as for values
for {set ldridx 0} {$ldridx < [llength $leaders]} {incr ldridx} {
set leadername [lindex $LEADER_NAMES $nameidx]
incr nameidx
set ldr [lindex $leaders $ldridx]
if {$leadername ne ""} {
if {[llength $leadername] == 1} {
set strideval $ldr
} else {
set strideval [list]
incr ldridx -1
foreach v $leadername {
incr ldridx
if {$ldridx > [llength $leaders]-1} {
set msg "Bad number of leaders for %caller%. Received [llength $strideval] values for '$leadername', but requires [llength $leadername] values."
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list stridevaluecount [llength $strideval] stride [llength $leadername] ] -argspecs $argspecs]] $msg
}
lappend strideval [lindex $leaders $ldridx]
}
}
if {[tcl::dict::get $argstate $leadername -multiple]} {
if {[tcl::dict::exists $LEADER_DEFAULTS $leadername]} {
tcl::dict::set leaders_dict $leadername [list $ldr] ;#important to treat first element as a list
#current stored ldr equals defined default - don't include default in the list we build up
tcl::dict::set leaders_dict $leadername [list $strideval] ;#important to treat first element as a list
} else {
tcl::dict::lappend leaders_dict $leadername $ldr
tcl::dict::lappend leaders_dict $leadername $strideval
}
set in_multiple $leadername
set leadername_multiple $leadername
} else {
tcl::dict::set leaders_dict $leadername $ldr
tcl::dict::set leaders_dict $leadername $strideval
}
lappend leadernames_received $leadername
} else {
if {$in_multiple ne ""} {
tcl::dict::lappend leaders_dict $in_multiple $ldr
lappend leadernames_received $in_multiple ;#deliberately allow dups! (as with opts and values)
if {$leadername_multiple ne ""} {
if {[llength $leadername_multiple] == 1} {
set strideval $ldr
} else {
set strideval [list]
incr ldridx -1
foreach v $leadername_multiple {
incr ldridx
if {$ldridx > [llength $leaders]-1} {
set msg "Bad number of leaders for %caller%. Received [llength $strideval] values for '$leadername_multiple', but requires [llength $leadername_multiple] values."
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list stridevaluecount [llength $strideval] stride [llength $leadername_multiple] ] -argspecs $argspecs]] $msg
}
lappend strideval [lindex $leaders $ldridx]
}
}
tcl::dict::lappend leaders_dict $leadername_multiple $strideval
#name already seen - but must add to leadernames_received anyway (as with opts and values)
lappend leadernames_received $leadername_multiple
} else {
tcl::dict::set leaders_dict $positionalidx $ldr
tcl::dict::set argstate $positionalidx $LEADERSPEC_DEFAULTS
@ -4466,10 +4507,42 @@ tcl::namespace::eval punk::args {
lappend leadernames_received $positionalidx
}
}
incr ldridx
incr positionalidx
set positionalidx [expr {$start_position + $ldridx + 1}]
}
#test args parse_withdef_leader_stride - todo
#change to for loop
#foreach leadername $LEADER_NAMES ldr $leaders {
# if {$ldridx+1 > $num_leaders} {
# break
# }
# if {$leadername ne ""} {
# if {[tcl::dict::get $argstate $leadername -multiple]} {
# if {[tcl::dict::exists $LEADER_DEFAULTS $leadername]} {
# tcl::dict::set leaders_dict $leadername [list $ldr] ;#important to treat first element as a list
# } else {
# tcl::dict::lappend leaders_dict $leadername $ldr
# }
# set leadername_multiple $leadername
# } else {
# tcl::dict::set leaders_dict $leadername $ldr
# }
# lappend leadernames_received $leadername
# } else {
# if {$leadername_multiple ne ""} {
# tcl::dict::lappend leaders_dict $leadername_multiple $ldr
# lappend leadernames_received $leadername_multiple ;#deliberately allow dups! (as with opts and values)
# } else {
# tcl::dict::set leaders_dict $positionalidx $ldr
# tcl::dict::set argstate $positionalidx $LEADERSPEC_DEFAULTS
# tcl::dict::set arg_checks $positionalidx $LEADER_CHECKS_DEFAULTS
# lappend leadernames_received $positionalidx
# }
# }
# incr ldridx
# incr positionalidx
#}
set validx 0
set valname_multiple ""
@ -4488,6 +4561,7 @@ tcl::namespace::eval punk::args {
#------------------------------------------
set nameidx 0
set start_position $positionalidx
#MAINTENANCE - same loop logic as for leaders
for {set validx 0} {$validx < [llength $values]} {incr validx} {
set valname [lindex $VAL_NAMES $nameidx]
incr nameidx
@ -4546,7 +4620,7 @@ tcl::namespace::eval punk::args {
lappend valnames_received $positionalidx
}
}
set positionalidx [expr {$start_position + $validx}]
set positionalidx [expr {$start_position + $validx + 1}]
}
#------------------------------------------

6653
src/vfs/_vfscommon.vfs/modules/punk/args-0.1.8.tm

File diff suppressed because it is too large Load Diff

6
src/vfs/_vfscommon.vfs/modules/punk/args/tclcore-0.1.0.tm

@ -1479,7 +1479,7 @@ tcl::namespace::eval punk::args::tclcore {
is synonymous with
lindex [lindex [lindex $a 1] 2] 3
When presented with a single indes, the lindex command treats list as a Tcl list
When presented with a single index, the lindex command treats list as a Tcl list
and returns the index'th element from it (0 refers to the first element of the
list). In extracting the element, lindex observes the same rules concerning
braces and quotes and backslashes as the Tcl command interpreter; however,
@ -1593,7 +1593,7 @@ tcl::namespace::eval punk::args::tclcore {
"tcl list as a value"
first -type indexexpression -help\
"index expression for first element"
last -type indexepxression -help\
last -type indexexpression -help\
"index expression for last element"
} "@doc -name Manpage: -url [manpage_tcl lrange]"
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
@ -1804,7 +1804,7 @@ tcl::namespace::eval punk::args::tclcore {
of the characters in ${$I}splitChars${$NI}. Empty list elements will be
generated if string contains adjacent characters in ${$I}splitChars${$NI},
or if the first or last character of string is in ${$I}splitChars${$NI}.
If ${I}splitChars${$NI} is an empty string then each character of ${$I}string${$NI}
If ${$I}splitChars${$NI} is an empty string then each character of ${$I}string${$NI}
becomes a separate element of the result list. ${$I}splitChars${$NI} defaults
to the standard white-space characters."
@values -min 1 -max 2

309
src/vfs/_vfscommon.vfs/modules/punk/args/tzint-1.1.1.tm

@ -0,0 +1,309 @@
# -*- tcl -*-
# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from <pkg>-buildversion.txt
# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.3.tm
#
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem.
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# (C) 2025
#
# @@ Meta Begin
# Application punk::args::tzint 1.1.1
# Meta platform tcl
# Meta license MIT
# @@ Meta End
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# doctools header
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[manpage_begin shellspy_module_punk::args::tzint 0 1.1.1]
#[copyright "2025"]
#[titledesc {Module API}] [comment {-- Name section and table of contents description --}]
#[moddesc {-}] [comment {-- Description at end of page heading --}]
#[require punk::args::tzint]
#[keywords module]
#[description]
#[para] -
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[section Overview]
#[para] overview of punk::args::tzint
#[subsection Concepts]
#[para] -
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Requirements
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[subsection dependencies]
#[para] packages used by punk::args::tzint
#[list_begin itemized]
package require Tcl 8.6-
#*** !doctools
#[item] [package {Tcl 8.6}]
# #package require frobz
# #*** !doctools
# #[item] [package {frobz}]
#*** !doctools
#[list_end]
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[section API]
tcl::namespace::eval punk::args::tzint {
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Base namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[subsection {Namespace punk::args::tzint}]
#[para] Core API functions for punk::args::tzint
#[list_begin definitions]
variable PUNKARGS
namespace eval argdoc {
proc get_symbologies {} {
if {[catch {
package require tzint
::tzint::Encode symbologies
} result]} {
return
} else {
return $result
}
}
# -- --- --- --- --- --- --- --- --- --- --- --- --- ---
lappend PUNKARGS [list {
@id -id ::tzint::Encode
@cmd -name "native tzint::Encode" -help\
""
@leaders -min 1 -max 1
command -type string -choices {version symbologies bits eps svg xbm}
@values -min 0 -max 0
} "@doc -name Wikipage: -url {https://wiki.tcl-lang.org/page/tzint+%2D+tcl+package+for+libzint+barcode+encoding+library+%28no+Tk+needed%29}" ]
# -- --- --- --- --- --- --- --- --- --- --- --- --- ---
lappend PUNKARGS [list {
@id -id "::tzint::Encode version"
@cmd -name "native tzint::Encode version" -help\
"Return the version of underlying libzint"
@values -min 0 -max 0
} "@doc -name Wikipage: -url {https://wiki.tcl-lang.org/page/tzint+%2D+tcl+package+for+libzint+barcode+encoding+library+%28no+Tk+needed%29}" ]
lappend PUNKARGS [list {
@id -id "::tzint::Encode symbologies"
@cmd -name "native tzint::Encode symbologies" -help\
"Return a list of symbology names that can be encoded.
These are values that can be supplied for the -symbology flag"
@values -min 0 -max 0
} "@doc -name Wikipage: -url {https://wiki.tcl-lang.org/page/tzint+%2D+tcl+package+for+libzint+barcode+encoding+library+%28no+Tk+needed%29}" ]
lappend PUNKARGS [list {
@dynamic
@id -id "::tzint::Encode svg"
@cmd -name "native tzint::Encode svg"
@leaders -min 2 -max 2
#review - error msg for Encode without args is "Encode command ?name|varName data? ?-option value ...?
#This implies "varName data" is optional - but in practice it seems not to be (?)
"varName data" -type {string string} -optional 0
@opts
-symbology -type string -choicerestricted 0 -choices {${[::punk::args::tzint::argdoc::get_symbologies]}}
-height -type integer -help\
"The height of a 1d symbol"
-whitespace -type integer -help\
"The amount of whitespace to the left and right of the generated barcode"
-bind -type boolean -default 0 -help\
"tzint allows the symbol to be bound with 'boundary bars'
These bars help to prevent misreading of the symbol by corrupting
a scan if the scanning beam strays off the top or bottom of the symbol."
-box -type boolean -help\
"Puts a border right around the symbol and its whitespace.
This option is automatically selected for ITF-14 symbols."
-border -type integer -help\
"Specifies width of boundary or box."
-fg|-foreground -type string -default "000000" -help\
"Foreground colour specified in RGB hexadecimal notation."
-bg|-background -type string -default "FFFFFF" -help\
"Background colour specified in RGB hexadecimal notation."
-rotate -type integer -default 0 -choices {0 90 180 270} -help\
"The symbol can be rotated through four orientations
by specifying one of the allowed angles of rotation."
-scale -type integer
-format -type string
-stat -type string -help\
"variable name for status data"
#barcode specific options
#TODO - what?
-cols -type integer -help\
"number of columns PDF417"
-vers -type integer -help\
"option QR Code and Plessy"
-security -type integer -help\
"error correction level PDF417 and QR Code"
-mode -type integer -help\
"structured primary data mode Maxicode and Composite"
-primary -type string -help\
"structured primary data Maxicode and Composite"
-notext -type boolean -help\
"no interpretation line"
-square -type boolean -help\
"force DataMatrix symbols to be square"
-init -type boolean -help\
"create reader initialisation symbol Code128 and DataMatrix"
-smalltext -type boolean -help\
"tiny interpretation line font"
#Changing the '0'/'1' character when using the bits command -- then -onchar and/or -offchar can be used
-onchar -type char
-offchar -type char
@values -min 0 -max 0
} "@doc -name Wikipage: -url {https://wiki.tcl-lang.org/page/tzint+%2D+tcl+package+for+libzint+barcode+encoding+library+%28no+Tk+needed%29}" ]
lappend PUNKARGS [list {
@dynamic
@id -id "::tzint::Encode xbm"
@cmd -name "native tzint::Encode xbm"
${[punk::args::resolved_def -antiglobs {@id @cmd} "::tzint::Encode svg"]}
} "@doc -name Wikipage: -url {https://wiki.tcl-lang.org/page/tzint+%2D+tcl+package+for+libzint+barcode+encoding+library+%28no+Tk+needed%29}" ]
}
#*** !doctools
#[list_end] [comment {--- end definitions namespace punk::args::tzint ---}]
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# == === === === === === === === === === === === === === ===
# Sample 'about' function with punk::args documentation
# == === === === === === === === === === === === === === ===
tcl::namespace::eval punk::args::tzint {
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase
variable PUNKARGS
variable PUNKARGS_aliases
lappend PUNKARGS [list {
@id -id "(package)punk::args::tzint"
@package -name "punk::args::tzint" -help\
"Package
Description"
}]
namespace eval argdoc {
#namespace for custom argument documentation
proc package_name {} {
return punk::args::tzint
}
proc about_topics {} {
#info commands results are returned in an arbitrary order (like array keys)
set topic_funs [info commands [namespace current]::get_topic_*]
set about_topics [list]
foreach f $topic_funs {
set tail [namespace tail $f]
lappend about_topics [string range $tail [string length get_topic_] end]
}
#Adjust this function or 'default_topics' if a different order is required
return [lsort $about_topics]
}
proc default_topics {} {return [list Description *]}
# -------------------------------------------------------------
# get_topic_ functions add more to auto-include in about topics
# -------------------------------------------------------------
proc get_topic_Description {} {
punk::args::lib::tstr [string trim {
package punk::args::tzint
description to come..
} \n]
}
proc get_topic_License {} {
return "MIT"
}
proc get_topic_Version {} {
return "$::punk::args::tzint::version"
}
proc get_topic_Contributors {} {
set authors {<unspecified>}
set contributors ""
foreach a $authors {
append contributors $a \n
}
if {[string index $contributors end] eq "\n"} {
set contributors [string range $contributors 0 end-1]
}
return $contributors
}
proc get_topic_custom-topic {} {
punk::args::lib::tstr -return string {
A custom
topic
etc
}
}
# -------------------------------------------------------------
}
# we re-use the argument definition from punk::args::standard_about and override some items
set overrides [dict create]
dict set overrides @id -id "::punk::args::tzint::about"
dict set overrides @cmd -name "punk::args::tzint::about"
dict set overrides @cmd -help [string trim [punk::args::lib::tstr {
About punk::args::tzint
documentation for tzint package
}] \n]
dict set overrides topic -choices [list {*}[punk::args::tzint::argdoc::about_topics] *]
dict set overrides topic -choicerestricted 1
dict set overrides topic -default [punk::args::tzint::argdoc::default_topics] ;#if -default is present 'topic' will always appear in parsed 'values' dict
set newdef [punk::args::resolved_def -antiglobs -package_about_namespace -override $overrides ::punk::args::package::standard_about *]
lappend PUNKARGS [list $newdef]
proc about {args} {
package require punk::args
#standard_about accepts additional choices for topic - but we need to normalize any abbreviations to full topic name before passing on
set argd [punk::args::parse $args withid ::punk::args::tzint::about]
lassign [dict values $argd] _leaders opts values _received
punk::args::package::standard_about -package_about_namespace ::punk::args::tzint::argdoc {*}$opts {*}[dict get $values topic]
}
}
# end of sample 'about' function
# == === === === === === === === === === === === === === ===
# -----------------------------------------------------------------------------
# register namespace(s) to have PUNKARGS,PUNKARGS_aliases variables checked
# -----------------------------------------------------------------------------
# variable PUNKARGS
# variable PUNKARGS_aliases
namespace eval ::punk::args::register {
#use fully qualified so 8.6 doesn't find existing var in global namespace
lappend ::punk::args::register::NAMESPACES ::punk::args::tzint ::punk::args::tzint::argdoc
}
# -----------------------------------------------------------------------------
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Ready
package provide punk::args::tzint [tcl::namespace::eval punk::args::tzint {
variable pkg punk::args::tzint
variable version
set version 1.1.1
}]
return
#*** !doctools
#[manpage_end]

BIN
src/vfs/_vfscommon.vfs/modules/test/punk/args-0.1.5.tm

Binary file not shown.
Loading…
Cancel
Save