32 changed files with 4269 additions and 528 deletions
@ -1,3 +1,7 @@ |
|||||||
src |
src |
||||||
src/deps |
src/vendorlib |
||||||
|
src/vendormodules |
||||||
src/modules |
src/modules |
||||||
|
src/lib |
||||||
|
lib |
||||||
|
modules |
||||||
|
|||||||
@ -0,0 +1,5 @@ |
|||||||
|
Documents and help files (for the repository website) |
||||||
|
These are html, markdown, manfiles etc which live within src/embedded and are intended to be checked into source control so they can form part of the online documentation available when browsing the repository. |
||||||
|
|
||||||
|
These files shouldn't be modified directly as they are built from the files in the src/doc folder |
||||||
|
(Using the Kettle build system) |
||||||
@ -0,0 +1,7 @@ |
|||||||
|
Tcl Library Source files for the project. |
||||||
|
|
||||||
|
These are Tcl packages which use the pkgIndex system. |
||||||
|
|
||||||
|
The Kettle Build tool can be used to generate pkgIndex.tcl files and install these to appropriate locations. |
||||||
|
|
||||||
|
|
||||||
@ -0,0 +1,11 @@ |
|||||||
|
Tcl Module Source files for the project. |
||||||
|
Consider using the punkshell pmix facility to create and manage these. |
||||||
|
|
||||||
|
pmix::newmodule <name> will create a basic .tm module template and assist in versioning. |
||||||
|
|
||||||
|
Tcl modules can be namespaced. |
||||||
|
For example |
||||||
|
> pmix::newmodule mymodule::utils |
||||||
|
will create the new module under src/modules/mymodule/utils |
||||||
|
|
||||||
|
|
||||||
@ -0,0 +1,3 @@ |
|||||||
|
Install a tclkit runtime here by running the appropriate fetchruntime script in ../src |
||||||
|
|
||||||
|
Alternatively the runtime can be downloaded from: https://www.gitea1.intx.com.au/jn/punkbin |
||||||
@ -0,0 +1,20 @@ |
|||||||
|
Create multishell scripts from your .tcl .sh and .ps1 scripts that are stored here. |
||||||
|
|
||||||
|
Use the pmix wrap functions to generate a multishell .cmd file from your scripts. |
||||||
|
This .cmd is a 'polyglot' script - it should run when called from any of the target interpreters. |
||||||
|
|
||||||
|
|
||||||
|
A multishell .cmd file is a cross-platform script that can easily be run on Windows and unix-like platforms. |
||||||
|
|
||||||
|
The .cmd extension is primarily a convenience so that it can be run easily by name on windows but it is ok to either leave it as that on other platforms, or rename it appropriately. |
||||||
|
|
||||||
|
On unix-like platforms it can be called with a bourne shell such as sh or bash. |
||||||
|
|
||||||
|
On windows, it can also be called with sh or bash if they are available - but the usual method would be to run it under cmd.exe initially just by opening a cmd prompt and running it. |
||||||
|
This will run some windows batch script to automatically generate a corresponding .ps1 file and execution will switch to powershell 5 or powershell 7 (pwsh) if available. |
||||||
|
Subsequently the command can be run directly from powershell. |
||||||
|
|
||||||
|
Whether called from Bourne shell, or cmd.exe or powershell - the usual payload would be your wrapped Tcl code - but it's also possible for powershell or sh/bash to be the primary payload script. |
||||||
|
Any of these languages could easily be used to detect and launch other scripts/utilities that you may distribute with your app. |
||||||
|
|
||||||
|
|
||||||
@ -0,0 +1,8 @@ |
|||||||
|
Tcl library dependencies |
||||||
|
|
||||||
|
Any pkgIndex based libraries that are external to the project but which the project owners wish to distribute with the project and keep under source control. |
||||||
|
|
||||||
|
These should generally be kept to a minimum |
||||||
|
- with dependency and version numbers being tracked instead; along with the provision of a mechanism for the project end-users to update. |
||||||
|
|
||||||
|
|
||||||
@ -0,0 +1,7 @@ |
|||||||
|
Tcl module dependencies |
||||||
|
|
||||||
|
Any .tm files that are external to the project but which the project owners wish to distribute with the project and keep under source control. |
||||||
|
|
||||||
|
These should generally be kept to a minimum |
||||||
|
- with dependency and version numbers being tracked instead; along with the provision of a mechanism for the project end-users to update. |
||||||
|
|
||||||
@ -1,106 +1,104 @@ |
|||||||
if (true=="shellbat") #;#\ |
: "[proc : args {}]" ;# *tcl shellbat - call with sh,bash,tclsh on any platform, or with cmd on windows. |
||||||
: <<'HIDE_FROM_BASH_AND_SH' |
: <<'HIDE_FROM_BASH_AND_SH' |
||||||
::lindex tcl;# leading colons hide from .bat, trailing slash hides next line from tcl \ |
: ;# leading colon hides from .bat, trailing slash hides next line from tcl \ |
||||||
@call tclsh "%~dp0%~n0.bat" %* |
@call tclsh "%~dp0%~n0.bat" %* |
||||||
::lindex tcl;#\ |
: ;#\ |
||||||
@set taskexitcode=%errorlevel% & goto :exit |
@set taskexitcode=%errorlevel% & goto :exit |
||||||
# -*- tcl -*- |
# -*- tcl -*- |
||||||
# ################################################################################################# |
# ################################################################################################# |
||||||
# This is a tcl shellbat file |
# This is a tcl shellbat file |
||||||
# It is tuned to run when called as a batch file, a tcl script, an sh script or a bash script, |
# It is tuned to run when called as a batch file, a tcl script, an sh script or a bash script, |
||||||
# so the specific layout and characters used are quite sensitive to change. |
# so the specific layout and characters used are quite sensitive to change. |
||||||
# It can be called on unix or windows platforms with or without the interpreter being specified on the commandline. |
# It can be called on unix or windows platforms with or without the interpreter being specified on the commandline. |
||||||
# e.g ./filename.sh.bat in sh or bash or powershell |
# e.g ./filename.sh.bat in sh or bash or powershell |
||||||
# e.g filename.sh or filename.sh.bat at windows command prompt |
# e.g filename.sh or filename.sh.bat at windows command prompt |
||||||
# e.g tclsh filename.sh.bat | sh filename.sh.bat | bash filename.sh.bat |
# e.g tclsh filename.sh.bat | sh filename.sh.bat | bash filename.sh.bat |
||||||
# In all cases an arbitrary number of arguments are accepted |
# In all cases an arbitrary number of arguments are accepted |
||||||
# To avoid the initial commandline on stdout when calling as a batch file on windows, use: |
# To avoid the initial commandline on stdout when calling as a batch file on windows, use: |
||||||
# cmd /Q /c filename.sh.bat |
# cmd /Q /c filename.sh.bat |
||||||
# (because we cannot use @if to silence it, as this isn't understood by tcl,sh or bash) |
# (because we cannot use @if to silence it, as this isn't understood by tcl,sh or bash) |
||||||
# ################################################################################################# |
# ################################################################################################# |
||||||
#fconfigure stdout -translation crlf |
#fconfigure stdout -translation crlf |
||||||
# --- --- --- --- --- --- --- --- --- --- --- --- ---begin Tcl Payload |
# --- --- --- --- --- --- --- --- --- --- --- --- ---begin Tcl Payload |
||||||
#puts "script : [info script]" |
#puts "script : [info script]" |
||||||
#puts "argcount : $::argc" |
#puts "argcount : $::argc" |
||||||
#puts "argvalues: $::argv" |
#puts "argvalues: $::argv" |
||||||
|
|
||||||
#<tcl-payload> |
|
||||||
|
#<tcl-payload> |
||||||
# --- --- --- --- --- --- --- --- --- --- --- --- --- |
|
||||||
# only exit if needed. see exitcode notes at bottom of file and exit there for consistency across invocation methods |
# --- --- --- --- --- --- --- --- --- --- --- --- --- |
||||||
# --- --- --- --- --- --- --- --- --- --- --- --- ---end Tcl Payload |
# only exit if needed. see exitcode notes at bottom of file and exit there for consistency across invocation methods |
||||||
#-- |
# --- --- --- --- --- --- --- --- --- --- --- --- ---end Tcl Payload |
||||||
#-- bash/sh code follows. |
#-- |
||||||
#-- protect from tcl using line continuation char on the previous comment for each line, like so: \ |
#-- bash/sh code follows. |
||||||
printf "etc" |
#-- protect from tcl using line continuation char on the previous comment for each line, like so: \ |
||||||
#-- or alternatively place sh/bash script within the false==false block |
printf "etc" |
||||||
#-- whilst being careful to balance braces {} |
#-- or alternatively place sh/bash script within the false==false block |
||||||
#-- For more complex needs you should call out to external scripts |
#-- whilst being careful to balance braces {} |
||||||
#-- |
#-- For more complex needs you should call out to external scripts |
||||||
#-- END marker for hide_from_bash_and_sh\ |
#-- |
||||||
HIDE_FROM_BASH_AND_SH |
#-- END marker for hide_from_bash_and_sh\ |
||||||
#\ |
HIDE_FROM_BASH_AND_SH |
||||||
then |
|
||||||
|
#--------------------------------------------------------- |
||||||
#--------------------------------------------------------- |
#-- This if statement hides(mostly) a sh/bash code block from Tcl |
||||||
if false==false # else { |
if false==false # else { |
||||||
then |
then |
||||||
: |
: |
||||||
#--------------------------------------------------------- |
#--------------------------------------------------------- |
||||||
#-- leave as is if all that's required is launching the Tcl payload" |
#-- leave as is if all that's required is launching the Tcl payload" |
||||||
#-- |
#-- |
||||||
#-- Note that sh/bash script isn't called when running a .bat from cmd.exe on windows by default |
#-- Note that sh/bash script isn't called when running a .bat from cmd.exe on windows by default |
||||||
#-- adjust line 4: @call tclsh ... to something like @call sh ... @call bash .. or @call env sh ... etc as appropriate |
#-- adjust line 4: @call tclsh ... to something like @call sh ... @call bash .. or @call env sh ... etc as appropriate |
||||||
#-- if sh/bash scripting needs to run on windows too. |
#-- if sh/bash scripting needs to run on windows too. |
||||||
#-- |
#-- |
||||||
#printf "start of bash or sh code" |
#printf "start of bash or sh code" |
||||||
|
|
||||||
|
|
||||||
#-- sh/bash launches Tcl here instead of shebang line at top |
#-- sh/bash launches Tcl here instead of shebang line at top |
||||||
|
|
||||||
#-- use exec to use exitcode (if any) directly from the tcl script |
#-- use exec to use exitcode (if any) directly from the tcl script |
||||||
exec /usr/bin/env tclsh "$0" "$@" |
exec /usr/bin/env tclsh "$0" "$@" |
||||||
|
|
||||||
#-- alternative - if sh/bash script required to run after the tcl call. |
#-- alternative - if sh/bash script required to run after the tcl call. |
||||||
#/usr/bin/env tclsh "$0" "$@" |
#/usr/bin/env tclsh "$0" "$@" |
||||||
#tcl_exitcode=$? |
#tcl_exitcode=$? |
||||||
#echo "tcl_exitcode: ${tcl_exitcode}" |
#echo "tcl_exitcode: ${tcl_exitcode}" |
||||||
|
|
||||||
#-- override exitcode example |
#-- override exitcode example |
||||||
#exit 66 |
#exit 66 |
||||||
|
|
||||||
#printf "No need for trailing slashes for sh/bash code here\n" |
#printf "No need for trailing slashes for sh/bash code here\n" |
||||||
#--------------------------------------------------------- |
#--------------------------------------------------------- |
||||||
fi |
fi |
||||||
# } |
# closing brace for Tcl } |
||||||
#--------------------------------------------------------- |
#--------------------------------------------------------- |
||||||
|
|
||||||
#-- comment for line sample 1 with trailing continuation slash \ |
#-- tcl and shell script now both active |
||||||
#printf "tcl-invisible sh/bash line sample 1 \n" |
|
||||||
|
#-- comment for line sample 1 with trailing continuation slash \ |
||||||
#-- comment for line sample 2 with trailing continuation slash \ |
#printf "tcl-invisible sh/bash line sample 1 \n" |
||||||
#printf "tcl-invisible sh/bash line sample 2 \n" |
|
||||||
|
#-- comment for line sample 2 with trailing continuation slash \ |
||||||
|
#printf "tcl-invisible sh/bash line sample 2 \n" |
||||||
#-- Consistent exitcode from sh,bash,tclsh or cmd |
|
||||||
#-- Call exit in tcl (or sh/bash) code only if explicitly required, otherwise leave this commented out. |
|
||||||
#-- (script might be more widely useable without explicit exit. e.g in tcl: set ::argc 1; set ::argv "val"; source filename.sh.bat ) |
#-- Consistent exitcode from sh,bash,tclsh or cmd |
||||||
#-- exit line unprotected by trailing slash will work for tcl and/or sh/bash |
#-- Call exit in tcl (or sh/bash) code only if explicitly required, otherwise leave this commented out. |
||||||
#exit 0 |
#-- (script might be more widely useable without explicit exit. e.g in tcl: set ::argc 1; set ::argv "val"; source filename.sh.bat ) |
||||||
#exit 42 |
#-- exit line unprotected by trailing slash will work for tcl and/or sh/bash |
||||||
|
#exit 0 |
||||||
|
#exit 42 |
||||||
#--------------------------------------------------------- |
|
||||||
#-- end if true==shellbat on very first line\ |
|
||||||
fi |
|
||||||
#--------------------------------------------------------- |
#-- make sure sh/bash/tcl all skip over .bat style exit \ |
||||||
|
: <<'shell_end' |
||||||
#-- make sure sh/bash/tcl all skip over .bat style exit \ |
#-- .bat exit with exitcode from tcl process \ |
||||||
: <<'shell_end' |
:exit |
||||||
#-- .bat exit with exitcode from tcl process \ |
: ;# \ |
||||||
:exit |
@exit /B %taskexitcode% |
||||||
::lindex tcl;#\ |
# .bat has exited \ |
||||||
@exit /B %taskexitcode% |
shell_end |
||||||
#\ |
|
||||||
shell_end |
|
||||||
|
|
||||||
|
|||||||
@ -0,0 +1,106 @@ |
|||||||
|
if (true=="shellbat") #;#\ |
||||||
|
: <<'HIDE_FROM_BASH_AND_SH' |
||||||
|
::lindex tcl;# leading colons hide from .bat, trailing slash hides next line from tcl \ |
||||||
|
@call tclsh "%~dp0%~n0.bat" %* |
||||||
|
::lindex tcl;#\ |
||||||
|
@set taskexitcode=%errorlevel% & goto :exit |
||||||
|
# -*- tcl -*- |
||||||
|
# ################################################################################################# |
||||||
|
# This is a tcl shellbat file |
||||||
|
# It is tuned to run when called as a batch file, a tcl script, an sh script or a bash script, |
||||||
|
# so the specific layout and characters used are quite sensitive to change. |
||||||
|
# It can be called on unix or windows platforms with or without the interpreter being specified on the commandline. |
||||||
|
# e.g ./filename.sh.bat in sh or bash or powershell |
||||||
|
# e.g filename.sh or filename.sh.bat at windows command prompt |
||||||
|
# e.g tclsh filename.sh.bat | sh filename.sh.bat | bash filename.sh.bat |
||||||
|
# In all cases an arbitrary number of arguments are accepted |
||||||
|
# To avoid the initial commandline on stdout when calling as a batch file on windows, use: |
||||||
|
# cmd /Q /c filename.sh.bat |
||||||
|
# (because we cannot use @if to silence it, as this isn't understood by tcl,sh or bash) |
||||||
|
# ################################################################################################# |
||||||
|
#fconfigure stdout -translation crlf |
||||||
|
# --- --- --- --- --- --- --- --- --- --- --- --- ---begin Tcl Payload |
||||||
|
#puts "script : [info script]" |
||||||
|
#puts "argcount : $::argc" |
||||||
|
#puts "argvalues: $::argv" |
||||||
|
|
||||||
|
#<tcl-payload> |
||||||
|
|
||||||
|
# --- --- --- --- --- --- --- --- --- --- --- --- --- |
||||||
|
# only exit if needed. see exitcode notes at bottom of file and exit there for consistency across invocation methods |
||||||
|
# --- --- --- --- --- --- --- --- --- --- --- --- ---end Tcl Payload |
||||||
|
#-- |
||||||
|
#-- bash/sh code follows. |
||||||
|
#-- protect from tcl using line continuation char on the previous comment for each line, like so: \ |
||||||
|
printf "etc" |
||||||
|
#-- or alternatively place sh/bash script within the false==false block |
||||||
|
#-- whilst being careful to balance braces {} |
||||||
|
#-- For more complex needs you should call out to external scripts |
||||||
|
#-- |
||||||
|
#-- END marker for hide_from_bash_and_sh\ |
||||||
|
HIDE_FROM_BASH_AND_SH |
||||||
|
#\ |
||||||
|
then |
||||||
|
|
||||||
|
#--------------------------------------------------------- |
||||||
|
if false==false # else { |
||||||
|
then |
||||||
|
: |
||||||
|
#--------------------------------------------------------- |
||||||
|
#-- leave as is if all that's required is launching the Tcl payload" |
||||||
|
#-- |
||||||
|
#-- Note that sh/bash script isn't called when running a .bat from cmd.exe on windows by default |
||||||
|
#-- adjust line 4: @call tclsh ... to something like @call sh ... @call bash .. or @call env sh ... etc as appropriate |
||||||
|
#-- if sh/bash scripting needs to run on windows too. |
||||||
|
#-- |
||||||
|
#printf "start of bash or sh code" |
||||||
|
|
||||||
|
|
||||||
|
#-- sh/bash launches Tcl here instead of shebang line at top |
||||||
|
|
||||||
|
#-- use exec to use exitcode (if any) directly from the tcl script |
||||||
|
exec /usr/bin/env tclsh "$0" "$@" |
||||||
|
|
||||||
|
#-- alternative - if sh/bash script required to run after the tcl call. |
||||||
|
#/usr/bin/env tclsh "$0" "$@" |
||||||
|
#tcl_exitcode=$? |
||||||
|
#echo "tcl_exitcode: ${tcl_exitcode}" |
||||||
|
|
||||||
|
#-- override exitcode example |
||||||
|
#exit 66 |
||||||
|
|
||||||
|
#printf "No need for trailing slashes for sh/bash code here\n" |
||||||
|
#--------------------------------------------------------- |
||||||
|
fi |
||||||
|
# } |
||||||
|
#--------------------------------------------------------- |
||||||
|
|
||||||
|
#-- comment for line sample 1 with trailing continuation slash \ |
||||||
|
#printf "tcl-invisible sh/bash line sample 1 \n" |
||||||
|
|
||||||
|
#-- comment for line sample 2 with trailing continuation slash \ |
||||||
|
#printf "tcl-invisible sh/bash line sample 2 \n" |
||||||
|
|
||||||
|
|
||||||
|
#-- Consistent exitcode from sh,bash,tclsh or cmd |
||||||
|
#-- Call exit in tcl (or sh/bash) code only if explicitly required, otherwise leave this commented out. |
||||||
|
#-- (script might be more widely useable without explicit exit. e.g in tcl: set ::argc 1; set ::argv "val"; source filename.sh.bat ) |
||||||
|
#-- exit line unprotected by trailing slash will work for tcl and/or sh/bash |
||||||
|
#exit 0 |
||||||
|
#exit 42 |
||||||
|
|
||||||
|
|
||||||
|
#--------------------------------------------------------- |
||||||
|
#-- end if true==shellbat on very first line\ |
||||||
|
fi |
||||||
|
#--------------------------------------------------------- |
||||||
|
|
||||||
|
#-- make sure sh/bash/tcl all skip over .bat style exit \ |
||||||
|
: <<'shell_end' |
||||||
|
#-- .bat exit with exitcode from tcl process \ |
||||||
|
:exit |
||||||
|
::lindex tcl;#\ |
||||||
|
@exit /B %taskexitcode% |
||||||
|
#\ |
||||||
|
shell_end |
||||||
|
|
||||||
@ -0,0 +1,28 @@ |
|||||||
|
#! /usr/bin/env tclsh |
||||||
|
# -*- tcl -*- |
||||||
|
|
||||||
|
# @@ Meta Begin |
||||||
|
# Application dtplite 1.0.5 |
||||||
|
# Meta platform tcl |
||||||
|
# Meta summary Lightweight DocTools Processor |
||||||
|
# Meta description This application is a simple processor |
||||||
|
# Meta description for documents written in the doctools |
||||||
|
# Meta description markup language. It covers the most |
||||||
|
# Meta description common use cases, but is not as |
||||||
|
# Meta description configurable as its big brother dtp. |
||||||
|
# Meta category Processing doctools documents |
||||||
|
# Meta subject doctools doctoc docidx |
||||||
|
# Meta require {dtplite 1.0.5} |
||||||
|
# Meta author Andreas Kupries |
||||||
|
# Meta license BSD |
||||||
|
# @@ Meta End |
||||||
|
|
||||||
|
package require dtplite 1.0.5 |
||||||
|
|
||||||
|
# dtp lite - Lightweight DocTools Processor |
||||||
|
# ======== = ============================== |
||||||
|
|
||||||
|
exit [dtplite::do $argv] |
||||||
|
|
||||||
|
# ### ### ### ######### ######### ######### |
||||||
|
exit |
||||||
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,195 @@ |
|||||||
|
#JMN - api should be kept in sync with package patternlib where possible |
||||||
|
# |
||||||
|
package provide oolib [namespace eval oolib { |
||||||
|
variable version |
||||||
|
set version 0.1 |
||||||
|
}] |
||||||
|
|
||||||
|
namespace eval oolib { |
||||||
|
oo::class create collection { |
||||||
|
variable o_data ;#dict |
||||||
|
variable o_alias |
||||||
|
constructor {} { |
||||||
|
set o_data [dict create] |
||||||
|
} |
||||||
|
method info {} { |
||||||
|
return [dict info $o_data] |
||||||
|
} |
||||||
|
method count {} { |
||||||
|
return [dict size $o_data] |
||||||
|
} |
||||||
|
method isEmpty {} { |
||||||
|
expr {[dict size $o_data] == 0} |
||||||
|
} |
||||||
|
method names {{globOrIdx {}}} { |
||||||
|
if {[llength $globOrIdx]} { |
||||||
|
if {[string is integer -strict $globOrIdx]} { |
||||||
|
if {$idx < 0} { |
||||||
|
set idx "end-[expr {abs($idx + 1)}]" |
||||||
|
} |
||||||
|
if {[catch {lindex [dict keys $o_data] $idx} result]} { |
||||||
|
error "[self object] no such index : '$idx'" |
||||||
|
} else { |
||||||
|
return $result |
||||||
|
} |
||||||
|
} else { |
||||||
|
#glob |
||||||
|
return [lsearch -glob -all -inline [dict keys $o_data] $globOrIdx] |
||||||
|
} |
||||||
|
} else { |
||||||
|
return [dict keys $o_data] |
||||||
|
} |
||||||
|
} |
||||||
|
#like names but without globbing |
||||||
|
method keys {} { |
||||||
|
dict keys $o_data |
||||||
|
} |
||||||
|
method key {{posn 0}} { |
||||||
|
if {$posn < 0} { |
||||||
|
set posn "end-[expr {abs($posn + 1)}]" |
||||||
|
} |
||||||
|
if {[catch {lindex [dict keys $o_data] $posn} result]} { |
||||||
|
error "[self object] no such index : '$posn'" |
||||||
|
} else { |
||||||
|
return $result |
||||||
|
} |
||||||
|
} |
||||||
|
method hasKey {key} { |
||||||
|
dict exists $o_data $key |
||||||
|
} |
||||||
|
method get {} { |
||||||
|
return $o_data |
||||||
|
} |
||||||
|
method items {} { |
||||||
|
return [dict values $o_data] |
||||||
|
} |
||||||
|
method item {key} { |
||||||
|
if {[string is integer -strict $key]} { |
||||||
|
if {$key > 0} { |
||||||
|
set valposn [expr {(2*$key) +1}] |
||||||
|
return [lindex $o_data $valposn] |
||||||
|
} else { |
||||||
|
set key "end-[expr {abs($key + 1)}]" |
||||||
|
return [lindex [dict keys $o_data] $key] |
||||||
|
} |
||||||
|
} |
||||||
|
if {[dict exists $o_data $key]} { |
||||||
|
return [dict get $o_data $key] |
||||||
|
} |
||||||
|
} |
||||||
|
#inverse lookup |
||||||
|
method itemKeys {value} { |
||||||
|
set value_indices [lsearch -all [dict values $o_data] $value] |
||||||
|
set keylist [list] |
||||||
|
foreach i $value_indices { |
||||||
|
set idx [expr {(($i + 1) *2) -2}] |
||||||
|
lappend keylist [lindex $o_data $idx] |
||||||
|
} |
||||||
|
return $keylist |
||||||
|
} |
||||||
|
method search {value args} { |
||||||
|
set matches [lsearch {*}$args [dict values $o_data] $value] |
||||||
|
if {"-inline" in $args} { |
||||||
|
return $matches |
||||||
|
} else { |
||||||
|
set keylist [list] |
||||||
|
foreach i $matches { |
||||||
|
set idx [expr {(($i + 1) *2) -2}] |
||||||
|
lappend keylist [lindex $o_data $idx] |
||||||
|
} |
||||||
|
return $keylist |
||||||
|
} |
||||||
|
} |
||||||
|
#review - see patternlib. Is the intention for aliases to be configurable independent of whether the target exists? |
||||||
|
method alias {newAlias existingKeyOrAlias} { |
||||||
|
if {[string is integer -strict $newAlias]} { |
||||||
|
error "[self object] collection key alias cannot be integer" |
||||||
|
} |
||||||
|
if {[string length $existingKeyOrAlias]} { |
||||||
|
set o_alias($newAlias) $existingKeyOrAlias |
||||||
|
} else { |
||||||
|
unset o_alias($newAlias) |
||||||
|
} |
||||||
|
} |
||||||
|
method aliases {{key ""}} { |
||||||
|
if {[string length $key]} { |
||||||
|
set result [list] |
||||||
|
foreach {n v} [array get o_alias] { |
||||||
|
if {$v eq $key} { |
||||||
|
lappend result $n $v |
||||||
|
} |
||||||
|
} |
||||||
|
return $result |
||||||
|
} else { |
||||||
|
return [array get o_alias] |
||||||
|
} |
||||||
|
} |
||||||
|
#if the supplied index is an alias, return the underlying key; else return the index supplied. |
||||||
|
method realKey {idx} { |
||||||
|
if {[catch {set o_alias($idx)} key]} { |
||||||
|
return $idx |
||||||
|
} else { |
||||||
|
return $key |
||||||
|
} |
||||||
|
} |
||||||
|
method add {value key} { |
||||||
|
if {[string is integer -strict $key]} { |
||||||
|
error "[self object] collection key must not be an integer. Use another structure if integer keys required" |
||||||
|
} |
||||||
|
if {[dict exists $o_data $key]} { |
||||||
|
error "[self object] col_processors object error: key '$key' already exists in collection" |
||||||
|
} |
||||||
|
dict set o_data $key $value |
||||||
|
return [expr {[dict size $o_data] - 1}] ;#return index of item |
||||||
|
} |
||||||
|
method remove {idx {endRange ""}} { |
||||||
|
if {[string length $endRange]} { |
||||||
|
error "[self object] collection error: ranged removal not yet implemented.. remove one item at a time" |
||||||
|
} |
||||||
|
if {[string is integer -strict $idx]} { |
||||||
|
if {$idx < 0} { |
||||||
|
set idx "end-[expr {abs($idx+1)}]" |
||||||
|
} |
||||||
|
set key [lindex [dict keys $o_data] $idx] |
||||||
|
set posn $idx |
||||||
|
} else { |
||||||
|
set key $idx |
||||||
|
set posn [lsearch -exact [dict keys $o_data] $key] |
||||||
|
if {$posn < 0} { |
||||||
|
error "[self object] no such index: '$idx' in this collection" |
||||||
|
} |
||||||
|
} |
||||||
|
dict unset o_data $key |
||||||
|
return |
||||||
|
} |
||||||
|
method clear {} { |
||||||
|
set o_data [dict create] |
||||||
|
return |
||||||
|
} |
||||||
|
method reverse {} { |
||||||
|
set dictnew [dict create] |
||||||
|
foreach k [lreverse [dict keys $o_data]] { |
||||||
|
dict set dictnew $k [dict get $o_data $k] |
||||||
|
} |
||||||
|
set o_data $dictnew |
||||||
|
return |
||||||
|
} |
||||||
|
#review - cmd as list vs cmd as script? |
||||||
|
method map {cmd} { |
||||||
|
set seed [list] |
||||||
|
dict for {k v} $o_data { |
||||||
|
lappend seed [uplevel #0 [list {*}$cmd $v]] |
||||||
|
} |
||||||
|
return $seed |
||||||
|
} |
||||||
|
method objectmap {cmd} { |
||||||
|
set seed [list] |
||||||
|
dict for {k v} $o_data { |
||||||
|
lappend seed [uplevel #0 [list $v {*}$cmd]] |
||||||
|
} |
||||||
|
return $seed |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
} |
||||||
|
|
||||||
Loading…
Reference in new issue