@ -132,38 +132,6 @@ tcl::namespace::eval punk::args::moduledoc::tclcore {
namespace import ::punk::args::helpers::*
#proc example {str} {
# 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 -------------------
# 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
# 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
# #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
#}
}
@ -4356,7 +4324,33 @@ tcl::namespace::eval punk::args::moduledoc::tclcore {
@values -min 0
arg -type string -optional 1 -multiple 1 -help\
"Usually, but not necessarily a proper Tcl list"
} "@doc -name Manpage: -url [manpage_tcl concat]" ]
} "@doc -name Manpage: -url [manpage_tcl concat]"\
{
@examples -help {
Although concat will concatenate lists, flattening them in the process (so giving the following interactive session):
${[example {
% ${$B}concat${$N} a b {c d e} {f {g h}}
a b c d e f {g h}
}]}
it will also concatenate things that are not lists, as can be seen from this session:
${[example {
% ${$B}concat${$N} " a b {c " d " e} f"
a b {c d e} f
}]}
Note also that the concatenation does not remove spaces from the middle of values, as can be seen here:
${[example {
% ${$B}concat${$N} "a b c" { d e f }
a b c d e f
}]}
(i.e., there are three spaces between each of the a, the b and the c).
For true list concatenation, the ${$B}list${$N} command should be used with expansion of each input list:
${[example {
% list {*}"a b c" {*}{ d e f }
a b c d e f
}]}
}
}]
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
lappend PUNKARGS [list {
@ -4386,7 +4380,44 @@ tcl::namespace::eval punk::args::moduledoc::tclcore {
varName -help ""
value
} "@doc -name Manpage: -url [manpage_tcl const]" ]
} "@doc -name Manpage: -url [manpage_tcl const]"\
{
@examples -help {
Create a constant in a procedure:
${[example {
proc foo {a b} {
${$B}const${$N} BAR 12345
return [expr {$a + $b + $BAR}]
}
}]}
Create a constant in a namespace to factor out a regular expression:
${[example {
namespace eval someNS {
${$B}const${$N} FOO_MATCHER {(?i)\mfoo\M}
proc findFoos str {
variable FOO_MATCHER
regexp -all $FOO_MATCHER $str
}
proc findFooIndices str {
variable FOO_MATCHER
regexp -all -indices $FOO_MATCHER $str
}
}
}]}
Making a constant in a loop doesn't error:
${[example {
proc foo {n} {
set result {}
for {set i 0} {$i < $n} {incr i} {
${$B}const${$N} X 123
lappend result [expr {$X + $i**2}]
}
}
}]}
}
}]
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
lappend PUNKARGS [list {
@id -id ::continue
@ -4478,7 +4509,17 @@ tcl::namespace::eval punk::args::moduledoc::tclcore {
code -type list -optional 1 -help\
"machine-readable data to store in -errorcode return option"
} "@doc -name Manpage: -url [manpage_tcl error]" ]
} "@doc -name Manpage: -url [manpage_tcl error]"\
{
@examples -help {
Generate an error if a basic mathematical operation fails:
${[example {
if {1+2 != 3} {
${$B}error${$N} "something is very wrong with addition"
}
}]}
}
}]
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
lappend PUNKARGS [list {
@id -id ::eval
@ -5160,6 +5201,125 @@ tcl::namespace::eval punk::args::moduledoc::tclcore {
}
}]
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
# ::interp subcommands
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
# ::interp alias
punk::args::define {
@id -id "::interp aliases"
@cmd -name "Built-in: ::interp aliases"\
-summary\
"List interp aliases"\
-help\
"This command returns a Tcl list of the tokens of all the source commands for aliases defined in the interpreter
identified by ${$I}path${$NI}. The tokens correspond to the values returned when the aliases were created (which may not be
the same as the current names of the commands)."
@values -min 0 -max 1
path -type string -optional 1
} "@doc -name Manpage: -url [punk::args::moduledoc::tclcore::manpage_tcl aliases]"
punk::args::define {
@id -id "::interp bgerror"
@cmd -name "Built-in: ::interp bgerror"\
-summary\
"Get/set interp's background error handler"\
-help\
"This command either gets or sets the current background exception handler for the interpreter identified by path.
If cmdPrefix is absent, the current background exception handler is returned, and if it is present, it is a list
of words (of minimum length one) that describes what to set the interpreter's background exception handler to.
See the BACKGROUND EXCEPTION HANDLING section for more details."
@values -min 1 -max 2
path -type string -optional 0
cmdPrefix -type list -optional 1
} "@doc -name Manpage: -url [punk::args::moduledoc::tclcore::manpage_tcl aliases]"
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
# ::interp
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
set INTERP_CHOICES [list alias aliases bgerror cancel children create debug delete eval exists expose hide hidden invokehidden issafe limit marktrusted recursionlimit share target transfer]
#manual synopses for subcommands not yet defined
set INTERP_CHOICELABELS [subst -novariables {
}]
set INTERP_CHOICEGROUPS [dict create\
"" {}\
lifecycle {create delete exists children}\
]
set INTERP_GROUPALLOCATED [list]
dict for {g glist} $INTERP_CHOICEGROUPS {
lappend INTERP_GROUPALLOCATED {*}$glist
}
foreach sub $INTERP_CHOICES {
if {$sub ni $INTERP_GROUPALLOCATED} {
dict lappend INTERP_CHOICEGROUPS "" $sub
}
}
set INTERP_CHOICEINFO [dict create]
foreach sub $INTERP_CHOICES {
#default for all
dict set INTERP_CHOICEINFO $sub {{doctype native}}
}
foreach id [punk::args::get_ids "::interp *"] {
if {[llength $id] == 2} {
lassign $id _ sub
dict set INTERP_CHOICEINFO $sub {{doctype native} {doctype punkargs}}
#override manual synopsis entry
dict set INTERP_CHOICELABELS $sub [punk::ansi::a+ normal][punk::args::synopsis "::interp $sub"]
}
}
#III
punk::args::define {
@id -id ::interp
@cmd -name "Built-in: ::interp"\
-summary\
"Create and manipulate Tcl interpreters."\
-help\
""
@leaders -min 1 -max 1
subcommand -type string\
-choicecolumns 2\
-choicegroups\
{${$INTERP_CHOICEGROUPS}}\
-unindentedfields {-choicelabels}\
-choicelabels\
{${$INTERP_CHOICELABELS}}\
-choiceinfo {${$INTERP_CHOICEINFO}}
@values -unnamed true
} "@doc -name Manpage: -url [punk::args::moduledoc::tclcore::manpage_tcl interp]"\
{
@examples -help {
Creating and using an alias for a command in the current interpreter:
${[example {
${$B}interp alias${$N} {} getIndex {} lsearch {alpha beta gamma delta}
set idx [getIndex delta]
}]}
Executing an arbitrary command in a safe interpreter where every invocation of ${$B}lappend${$N} is logged:
${[example {
set i [${$B}interp create${$N} -safe]
${$B}interp hide${$N} $i lappend
${$B}interp alias${$N} $i lappend {} loggedLappend $i
proc loggedLappend {i args} {
puts "logged invocation of lappend $args"
${$B}interp invokehidden${$N} $i lappend {*}$args
}
${$B}interp eval${$N} $i $someUntrustedScript
}]}
Setting a resource limit on an interpreter so that an infinite loop terminates.
${[example {
set i [${$B}interp create${$N}]
${$B}interp limit${$N} $i command -value 1000
${$B}interp eval${$N} $i {
set x 0
while {1} {
puts "Counting up... [incr x]"
}
}
}]}
}
}
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
lappend PUNKARGS [list {
@dynamic
@ -6790,6 +6950,7 @@ tcl::namespace::eval punk::args::moduledoc::tclcore {
}
}
#III
punk::args::define {
@id -id ::package
@cmd -name "Built-in: ::package"\
@ -7012,6 +7173,170 @@ tcl::namespace::eval punk::args::moduledoc::tclcore {
} "@doc -name Manpage: -url [manpage_tcl read]"
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
punk::args::define {
@id -id ::regsub
@cmd -name "Built-in: regsub"\
-summary\
"Perform substitutions based on regular expression pattern matching."\
-help\
"This command matches the regular expression ${$I}exp${$NI} against ${$I}string${$NI}, and either copies string to the
variable whose name is given by ${$I}varName${$NI} or returns ${$I}string${$NI} if ${$I}varName${$NI} is not present. (Regular
expression matching is described in the re_syntax reference page.) If there is a match, then while
copying ${$I}string${$NI} to ${$I}varName${$NI} (or to the result of this command if ${$I}varName${$NI} is not present) the portion
of string that matched ${$I}exp${$NI} is replaced with ${$I}subSpec${$NI}. If ${$I}subSpec${$NI} contains a “&” or “\0”, then it is
replaced in the substitution with the portion of ${$I}string${$NI} that matched ${$I}exp${$NI}. If ${$I}subSpec${$NI} contains a “\n”,
where n is a digit between 1 and 9, then it is replaced in the substitution with the portion of
${$I}string${$NI} that matched the n'th parenthesized subexpression of ${$I}exp${$NI}. Additional backslashes may be used
in ${$I}subSpec${$NI} to prevent special interpretation of “&”, “\0”, “\n” and backslashes. The use of
backslashes in ${$I}subSpec${$NI} tends to interact badly with the Tcl parser's use of backslashes, so it is
generally safest to enclose ${$I}subSpec${$NI} in braces if it includes backslashes.
If the initial arguments to ${$B}regsub${$N} start with - then they are treated as switches."
@leaders -min 0 -max 0
@opts
-all -type none -help\
{All ranges in string that match exp are found and substitution is performed for each of
these ranges. Without this switch only the first matching range is found and substituted.
If ${$B}-all${$N} is specified, then “&” and “\n” sequences are handled for each substitution using
the information from the corresponding match.}
-command -type none -help\
{Changes the handling of subSpec so that it is not treated as a template for a substitution
string and the substrings “&” and “\n” no longer have special meaning. Instead subSpec must
be a command prefix, that is, a non-empty list. The substring of string that matches exp,
and then each substring that matches each capturing sub-RE within exp are appended as
additional elements to that list. (The items appended to the list are much like what regexp
-inline would return). The completed list is then evaluated as a Tcl command, and the result
of that command is the substitution string. Any error or exception from command evaluation
becomes an error or exception from the ${$B}regsub${$N} command.
If -all is not also given, the command callback will be invoked at most once (exactly when
the regular expression matches). If -all is given, the command callback will be invoked for
each matched location, in sequence. The exact location indices that matched are not made
available to the script.
See EXAMPLES (cmd: eg regsub) for illustrative cases.}
-expanded -type none -help\
"Enables use of the expanded regular expression syntax where whitespace and comments are ignored.
This is the same as specifying the (?x) embedded option (see the re_syntax manual page).
"
-line -type none -help\
"Enables newline-sensitive matching. By default, newline is a completely ordinary character with
no special meaning. With this flag, “[^” bracket expressions and “.” never match newline, “^”
@#<nodisplay> ]
matches an empty string after any newline in addition to its normal function, and “$” matches
an empty string before any newline in addition to its normal function. This flag is equivalent
to specifying both ${$B}-linestop${$N} and ${$B}-lineanchor${$N}, or the (?n) embedded option (see the re_syntax
manual page).
"
-linestop -type none -help\
"Changes the behavior of “[^” bracket expressions and “.” so that they stop at newlines. This is
@#<nodisplay> ]
the same as specifying the (?p) embedded option (see the re_syntax manual page).
"
-lineanchor -type none -help\
"Changes the behavior of “^” and “$” (the “anchors”) so they match the beginning and end of a
line respectively. This is the same as specifying the (?w) embedded option (see the re_syntax
manual page)."
-nocase -type none -help\
"Upper-case characters in string will be converted to lower-case before matching against exp;
however, substitutions specified by subSpec use the original unconverted form of string."
-start -type indexexpression -typesynopsis {${$I}index${$NI}} -help\
"Specifies a character index offset into the string to start matching the regular
expression at. The index value is interpreted in the same manner as the index
argument to string index. When using this switch, “^” will not match the
beginning of the line, and \A will still match the start of the string at index.
index will be constrained to the bounds of the input string."
-- -type none
@values -min 3 -max 4
exp -type string -help "regular expression"
string
subSpec -type string -help "substitution specification"
varName -type string -optional 1 -help\
"If ${$I}varName${$NI} is supplied, the command returns a count of the number of matching
ranges that were found and replaced, otherwise the string after replacement is
returned. See the manual entry for ${$B}regexp${$N} for details on the interpretation of
regular expressions."
} "@doc -name Manpage: -url [manpage_tcl regsub]"\
{
@examples -help {
Replace (in the string in variable ${$I}string${$NI}) every instance of ${$B}foo${$N} which is a word by itself with ${$B}bar${$N}:
${[example {
${$B}regsub${$N} -all {\mfoo\M} $string bar string
}]}
or (using the “basic regular expression” syntax):
${[example {
${$B}regsub${$N} -all {(?b)\<foo\>} $string bar string
}]}
Insert double-quotes around the first instance of the word ${$B}interesting${$N}, however it is capitalized.
${[example {
${$B}regsub${$N} -nocase {\yinteresting\y} $string {"&"} string
}]}
Convert all non-ASCII and Tcl-significant characters into \u escape sequences by using ${$B}regsub${$N} and ${$B}subst${$N} in combination:
${[example {
# This RE is just a character class for almost everything "bad"
set RE {[][{};#\\\$ \r\t\u0080-\uffff]}
# We will substitute with a fragment of Tcl script in brackets
set substitution {[format \\\\u%04x [scan "\\&" %c]]}
# Now we apply the substitution to get a subst-string that
# will perform the computational parts of the conversion. Note
# that newline is handled specially through string map since
# backslash-newline is a special sequence.
set quoted [subst [string map {\n {\\u000a}} \
[${$B}regsub${$N} -all $RE $string $substitution]]]
}]}
The above operation can be done using ${$B}regsub -command${$N} instead, which is often faster.
(A full pre-computed string map would be faster still, but the cost of computing the map
for a transformation as complex as this can be quite large.)
${[example {
# This RE is just a character class for everything "bad"
set RE {[][{};#\\\$\s\u0080-\uffff]}
# This encodes what the RE described above matches
proc encodeChar {ch} {
# newline is handled specially since backslash-newline is a
# special sequence.
if {$ch eq "\n"} {
return "\\u000a"
}
# No point in writing this as a one-liner
scan $ch %c charNumber
format "\\u%04x" $charNumber
}
set quoted [${$B}regsub${$N} -all -command $RE $string encodeChar]
}]}
Decoding a URL-encoded string using ${$B}regsub -command${$N}, a lambda term and the ${$B}apply${$N} command.
${[example {
# Match one of the sequences in a URL-encoded string that needs
# fixing, converting + to space and %XX to the right character
# (e.g., %7e becomes ~)
set RE {(\+)|%([0-9A-Fa-f]{2})}
# Note that -command uses a command prefix, not a command name
set decoded [${$B}regsub${$N} -all -command $RE $string {apply {{- p h} {
# + is a special case; handle directly
if {$p eq "+"} {
return " "
}
# convert hex to a char
scan $h %x charNumber
format %c $charNumber
}}}]
}]}
The ${$B}-command${$N} option can also be useful for restricting the range of commands such as ${$B}string totitle${$N}:
${[example {
set message "the quIck broWn fOX JUmped oVer the laZy dogS..."
puts [${$B}regsub${$N} -all -command {\w+} $message {string totitle}]
# → The Quick Brown Fox Jumped Over The Lazy Dogs..
}]}
}
}
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
punk::args::define {
@id -id ::rename
@ -7027,7 +7352,22 @@ tcl::namespace::eval punk::args::moduledoc::tclcore {
@values -min 2 -max 2
oldName -type string
newName -type string
} "@doc -name Manpage: -url [manpage_tcl rename]"
} "@doc -name Manpage: -url [manpage_tcl rename]"\
{
@examples -help {
The ${$B}rename${$N} command can be used to wrap the standard Tcl commands with your own monitoring machinery.
For example, you might wish to count how often the ${$B}source${$N} command is called:
${[example {
${$B}rename${$N} ::source ::theRealSource
set sourceCount 0
proc ::source args {
global sourceCount
puts "called source for the [incr sourceCount]'th time"
uplevel 1 ::theRealSource $args
}
}]}
}
}
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
@ -10395,35 +10735,6 @@ tcl::namespace::eval punk::args::moduledoc::tclcore {
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Secondary API namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
tcl::namespace::eval punk::args::moduledoc::tclcore::lib {
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase
tcl::namespace::path [tcl::namespace::parent]
#*** !doctools
#[subsection {Namespace punk::args::moduledoc::tclcore::lib}]
#[para] Secondary functions that are part of the API
#[list_begin definitions]
#proc utility1 {p1 args} {
# #*** !doctools
# #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]]
# #[para]Description of utility1
# return 1
#}
#*** !doctools
#[list_end] [comment {--- end definitions namespace punk::args::moduledoc::tclcore::lib ---}]
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval ::punk::args::register {
#use fully qualified so 8.6 doesn't find existing var in global namespace
