Browse Source

update modules & vendormodules - netbox,tomlish + minor edits in others

master
Julian Noble 1 week ago
parent
commit
1ab0de6cef
  1. 83
      src/modules/punk-0.1.tm
  2. 3
      src/modules/punk/ansi-999999.0a1.0.tm
  3. 65
      src/modules/punk/cap/handlers/templates-999999.0a1.0.tm
  4. 5
      src/modules/punk/mix/base-0.1.tm
  5. 20
      src/modules/punk/mix/cli-999999.0a1.0.tm
  6. 6
      src/modules/punk/mix/commandset/module-999999.0a1.0.tm
  7. 10
      src/modules/punk/mix/commandset/project-999999.0a1.0.tm
  8. 26
      src/modules/punk/mix/commandset/repo-999999.0a1.0.tm
  9. 13
      src/modules/punk/mix/templates/layouts/project/src/make.tcl
  10. 7
      src/modules/punk/mod-0.1.tm
  11. 15
      src/modules/punk/netbox-999999.0a1.0.tm
  12. 21
      src/modules/punk/path-999999.0a1.0.tm
  13. 5
      src/modules/punk/repl-999999.0a1.0.tm
  14. 132
      src/modules/punk/repo-999999.0a1.0.tm
  15. 114
      src/modules/punkcheck-0.1.0.tm
  16. 2
      src/vendormodules/commandstack-0.3.tm
  17. 21
      src/vendormodules/fauxlink-0.1.1.tm
  18. 1
      src/vendormodules/include_modules.config
  19. BIN
      src/vendormodules/packageTest-0.1.1.tm
  20. BIN
      src/vendormodules/test/tomlish-1.1.1.tm
  21. BIN
      src/vendormodules/test/tomlish-1.1.3.tm
  22. 160
      src/vendormodules/tomlish-1.1.2.tm
  23. 1484
      src/vendormodules/tomlish-1.1.3.tm

83
src/modules/punk-0.1.tm

@ -141,6 +141,7 @@ namespace eval punk {
}
if {[llength [file split $name]] != 1} {
#has a path
foreach ext $execExtensions {
set file ${name}${ext}
if {[file exists $file] && ![file isdirectory $file]} {
@ -164,14 +165,20 @@ namespace eval punk {
}
foreach var {PATH Path path} {
if {[info exists env($var)]} {
append path ";$env($var)"
}
if {[info exists env($var)]} {
append path ";$env($var)"
}
}
#change2
set lookfor [lmap ext $execExtensions {string cat ${name} ${ext}}]
if {[file extension $name] ne "" && [string tolower [file extension $name]] in [string tolower $execExtensions]} {
set lookfor [list $name]
} else {
set lookfor [lmap ext $execExtensions {string cat ${name} ${ext}}]
}
#puts "-->$lookfor"
foreach dir [split $path {;}] {
set dir [string trim $dir {\\}] ;#trailing slash will result in a tail such as "/python.exe"
#set dir [file normalize $dir]
# Skip already checked directories
if {[info exists checked($dir)] || ($dir eq "")} {
@ -179,6 +186,24 @@ namespace eval punk {
}
set checked($dir) {}
#surprisingly fast
#set matches [glob -nocomplain -dir $dir -types f -tails {*}$lookfor]
##puts "--dir $dir matches:$matches"
#if {[llength $matches]} {
# set file [file join $dir [lindex $matches 0]]
# #puts "--match0:[lindex $matches 0] file:$file"
# return [set auto_execs($name) [list $file]]
#}
#what if it's a link?
#foreach match [glob -nocomplain -dir $dir -types f -tail {*}$lookfor] {
# set file [file join $dir $match]
# if {[file exists $file]} {
# return [set auto_execs($name) [list $file]]
# }
#}
#safest? could be a link?
foreach match [glob -nocomplain -dir $dir -tail {*}$lookfor] {
set file [file join $dir $match]
if {[file exists $file] && ![file isdirectory $file]} {
@ -6775,31 +6800,36 @@ namespace eval punk {
}
punk::args::define {
@dynamic
@id -id ::punk::LOC
@cmd -name punk::LOC -help\
"LOC - lines of code.
An implementation of a notoriously controversial metric"
-return -default showdict -choices {dict showdict}
-dir -default "\uFFFF"
-exclude_dupfiles -default 1 -type boolean
${[punk::args::resolved_def -types opts ::punk::path::treefilenames -antiglob_paths]}
-antiglob_files -default "" -type list -help\
"Exclude if file tail matches any of these patterns"
-exclude_punctlines -default 1 -type boolean
-show_largest -default 0 -type integer -help\
"Report the top largest linecount files.
The value represents the number of files
to report on."
} "
#we could map away whitespace and use string is punct - but not as flexible? review
-punctchars -default { [list \{ \} \" \\ - _ + = . > , < ' : \; ` ~ ! @ # \$ % ^ & * \[ \] ( ) | / ?] }
"
#An implementation of a notoriously controversial metric.
proc LOC {args} {
set argspecs [subst {
@dynamic
@id -id ::punk::LOC
@cmd -name punk::LOC -help\
"LOC - lines of code.
An implementation of a notoriously controversial metric"
-dir -default "\uFFFF"
-exclude_dupfiles -default 1 -type boolean
${[punk::args::resolved_def ::punk::path::treefilenames -antiglob_paths]}
-exclude_punctlines -default 1 -type boolean
-show_largest -default 0 -type integer -help\
"Report the top largest linecount files.
The value represents the number of files
to report on."
#we could map away whitespace and use string is punct - but not as flexible? review
-punctchars -default { [list \{ \} \" \\ - _ + = . > , < ' : \; ` ~ ! @ # \$ % ^ & * \[ \] ( ) | / ?] }
}]
set argd [punk::args::get_dict $argspecs $args]
set argd [punk::args::parse $args withid ::punk::LOC]
lassign [dict values $argd] leaders opts values received
set searchspecs [dict values $values]
# -- --- --- --- --- ---
set opt_dir [dict get $opts -dir]
set opt_return [dict get $opts -return]
set opt_dir [dict get $opts -dir]
if {$opt_dir eq "\uFFFF"} {
set opt_dir [pwd] ;#pwd can take over a ms on windows in a not terribly deep path even with SSDs - so as a general rule we don't use it in the original defaults list
}
@ -6808,10 +6838,12 @@ namespace eval punk {
set opt_exclude_punctlines [dict get $opts -exclude_punctlines] ;#exclude lines that consist purely of whitespace and the chars in -punctchars
set opt_punctchars [dict get $opts -punctchars]
set opt_largest [dict get $opts -show_largest]
set opt_antiglob_paths [dict get $opts -antiglob_paths]
set opt_antiglob_files [dict get $opts -antiglob_files]
# -- --- --- --- --- ---
set filepaths [punk::path::treefilenames -dir $opt_dir {*}$searchspecs]
set filepaths [punk::path::treefilenames -dir $opt_dir -antiglob_paths $opt_antiglob_paths -antiglob_files $opt_antiglob_files {*}$searchspecs]
set loc 0
set dupfileloc 0
set seentails [dict create]
@ -6941,6 +6973,9 @@ namespace eval punk {
}
dict set result largest $largest_n
}
if {$opt_return eq "showdict"} {
return [punk::lib::showdict $result @@dupinfo/*/* !@@dupinfo]
}
return $result
}

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

@ -2469,7 +2469,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
}
if {$pretty} {
#return [pdict -channel none sgr_cache */%str,%ansiview]
return [pdict -channel none sgr_cache */%rpadstr-"sample",%ansiviewstyle]
return [punk::lib::pdict -channel none sgr_cache */%rpadstr-"sample",%ansiviewstyle]
}
if {[catch {
@ -5116,6 +5116,7 @@ tcl::namespace::eval punk::ansi::ta {
# arrow keys -> ESC O A, ESC O B, ESC O C, ESC O D
# plus more for auxiliary keypad codes in keypad application mode (and some in numeric mode)
#regexp expanded syntax = ?x
variable re_ansi_detect {(?x)
(?:\x1b(?:\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|c|7|8|M|D|E|H|=|>|<|A|B|C|I|J|K|L|M|Z|(?:Y(?:..))|(?:b(?:.))|\((?:0|B)|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|(?:\#(?:3|4|5|6|8))))
|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)

65
src/modules/punk/cap/handlers/templates-999999.0a1.0.tm

@ -108,8 +108,10 @@ namespace eval punk::cap::handlers::templates {
#todo - handle wrapped or unwrapped tarjar files - in which case we have to adjust tmfolder appropriately
#set tpath [file normalize [file join $tmfile [dict get $capdict relpath]]] ;#relpath is relative to the tm *file* - not it's containing folder
set projectinfo [punk::repo::find_repos $tmfolder]
set projectbase [dict get $projectinfo closest]
#set projectinfo [punk::repo::find_repos $tmfolder] ;#slow - REVIEW
#set projectbase [dict get $projectinfo closest]
set projectbase [punk::repo::find_project $tmfolder]
#store the projectbase even if it's empty string
set extended_capdict $capdict
set resolved_path [file join $tmfolder $path]
@ -148,8 +150,9 @@ namespace eval punk::cap::handlers::templates {
return 0
}
set shellbase [file dirname [file dirname [file normalize [set ::argv0]/__]]] ;#review
set projectinfo [punk::repo::find_repos $shellbase]
set projectbase [dict get $projectinfo closest]
#set projectinfo [punk::repo::find_repos $shellbase]
#set projectbase [dict get $projectinfo closest]
set projectbase [punk::repo::find_project $shellbase]
set extended_capdict $capdict
dict set extended_capdict vendor $vendor
@ -166,8 +169,9 @@ namespace eval punk::cap::handlers::templates {
return 0
}
set shellbase [file dirname [file dirname [file normalize [set ::argv0]/__]]] ;#review
set projectinfo [punk::repo::find_repos $shellbase]
set projectbase [dict get $projectinfo closest]
#set projectinfo [punk::repo::find_repos $shellbase]
#set projectbase [dict get $projectinfo closest]
set projectbase [punk::repo::find_project $shellbase]
set extended_capdict $capdict
dict set extended_capdict vendor $vendor
@ -183,8 +187,9 @@ namespace eval punk::cap::handlers::templates {
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - package '$pkg' is attempting to register with punk::cap as a provider of '$capname' capability but provided a path '$path' which doesn't seem to exist"
return 0
}
set projectinfo [punk::repo::find_repos $normpath]
set projectbase [dict get $projectinfo closest]
#set projectinfo [punk::repo::find_repos $normpath]
#set projectbase [dict get $projectinfo closest]
set projectbase [punk::repo::find_project $normpath]
#todo - verify no other provider has registered same absolute path - if sharing a project-external location is needed - they need their own subfolder
set extended_capdict $capdict
@ -244,6 +249,18 @@ namespace eval punk::cap::handlers::templates {
# -- --- --- --- --- --- ---
namespace export *
namespace eval class {
variable PUNKARGS
#set argd [punk::args::get_dict {
# @id -id "::punk::cap::handlers::templates::class::api folders"
# -startdir -default ""
# @values -max 0
#} $args]
lappend PUNKARGS [list {
@id -id "::punk::cap::handlers::templates::class::api folders"
-startdir -default ""
@values -max 0
}]
oo::class create api {
#return a dict keyed on folder with source pkg as value
constructor {capname} {
@ -253,11 +270,8 @@ namespace eval punk::cap::handlers::templates {
set capabilityname $capname
}
method folders {args} {
set argd [punk::args::get_dict {
@id -id "::punk::cap::handlers::templates::class::api folders"
-startdir -default ""
@values -max 0
} $args]
#puts "--folders $args"
set argd [punk::args::parse $args withid "::punk::cap::handlers::templates::class::api folders"]
set opts [dict get $argd opts]
set opt_startdir [dict get $opts -startdir]
@ -270,6 +284,10 @@ namespace eval punk::cap::handlers::templates {
set startdir $opt_startdir
}
}
set searchbase $startdir
#set pathinfo [punk::repo::find_repos $searchbase] ;#relatively slow! REVIEW - pass as arg? cache?
#set pwd_projectroot [dict get $pathinfo closest]
set pwd_projectroot [punk::repo::find_project $searchbase]
variable capabilityname
@ -314,9 +332,9 @@ namespace eval punk::cap::handlers::templates {
set module_projectroot [dict get $capdecl_extended projectbase]
dict lappend found_paths_module $vendor [list pkg $pkg path [dict get $capdecl_extended resolved_path] pathtype $pathtype projectbase $module_projectroot]
} elseif {$pathtype eq "currentproject_multivendor"} {
set searchbase $startdir
set pathinfo [punk::repo::find_repos $searchbase]
set pwd_projectroot [dict get $pathinfo closest]
#set searchbase $startdir
#set pathinfo [punk::repo::find_repos $searchbase]
#set pwd_projectroot [dict get $pathinfo closest]
if {$pwd_projectroot ne ""} {
set deckbase [file join $pwd_projectroot $path]
if {![file exists $deckbase]} {
@ -349,9 +367,9 @@ namespace eval punk::cap::handlers::templates {
}
}
} elseif {$pathtype eq "currentproject"} {
set searchbase $startdir
set pathinfo [punk::repo::find_repos $searchbase]
set pwd_projectroot [dict get $pathinfo closest]
#set searchbase $startdir
#set pathinfo [punk::repo::find_repos $searchbase]
#set pwd_projectroot [dict get $pathinfo closest]
if {$pwd_projectroot ne ""} {
#path relative to projectroot already validated by handler as being within a currentproject_multivendor tree
set targetfolder [file join $pwd_projectroot $path]
@ -489,8 +507,9 @@ namespace eval punk::cap::handlers::templates {
set refdict [my get_itemdict_projectlayoutrefs {*}$args]
set layoutdict [dict create]
set projectinfo [punk::repo::find_repos $searchbase]
set projectroot [dict get $projectinfo closest]
#set projectinfo [punk::repo::find_repos $searchbase]
#set projectroot [dict get $projectinfo closest]
set projectroot [punk::repo::find_project $searchbase]
dict for {layoutname refinfo} $refdict {
set templatepathtype [dict get $refinfo sourceinfo pathtype]
@ -760,6 +779,10 @@ namespace eval punk::cap::handlers::templates {
}
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::cap::handlers::templates ::punk::cap::handlers::templates::class
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Ready

5
src/modules/punk/mix/base-0.1.tm

@ -767,6 +767,8 @@ namespace eval punk::mix::base {
dict for {path pathinfo} $dict_path_cksum {
puts "fill_relativecksums_from_base_and_relativepathdict-->$path REVIEW"
#review to see if we process same path repeatedly, so could avoid repeated 'file exists $fullpath' below by caching a glob
if {![dict exists $pathinfo cksum]} {
dict set pathinfo cksum ""
} else {
@ -851,7 +853,7 @@ namespace eval punk::mix::base {
}
} else {
if {[file type $specifiedpath] eq "relative"} {
if {[file pathtype $specifiedpath] eq "relative"} {
#if specifiedpath is relative - and we don't have a base, we now need to convert relative to cwd to an absolute path for storage
set targetpath [file normalize $specifiedpath]
set storedpath $targetpath
@ -911,6 +913,7 @@ namespace eval punk::mix::base {
}
#buildruntime.exe obsolete..
puts stderr "warning obsolete? get_all_vfs_build_cksums 'buildruntime.exe'???"
set fullpath_buildruntime $buildfolder/buildruntime.exe
set ckinfo_buildruntime [cksum_path $fullpath_buildruntime]

20
src/modules/punk/mix/cli-999999.0a1.0.tm

@ -412,9 +412,9 @@ namespace eval punk::mix::cli {
set repopaths [punk::repo::find_repos [pwd]]
set repos [dict get $repopaths repos]
if {![llength $repos]} {
append result [dict get $repopaths warnings]
append result [punk::ansi::a+ bold yellow][dict get $repopaths warnings][punk::ansi::a]
} else {
append result [dict get $repopaths warnings]
append result [punk::ansi::a+ bold yellow][dict get $repopaths warnings][punk::ansi::a]
lassign [lindex $repos 0] repopath repotypes
if {"fossil" in $repotypes} {
#review - multiple process launches to fossil a bit slow on windows..
@ -739,7 +739,7 @@ namespace eval punk::mix::cli {
}
} else {
puts -nonewline stderr "."
puts -nonewline stderr "P"
set did_skip 1
#set file_record [punkcheck::installfile_skipped_install $basedir $file_record]
$build_event targetset_end SKIPPED
@ -771,7 +771,7 @@ namespace eval punk::mix::cli {
$event targetset_end OK -note "zip modpod"
}
} else {
puts -nonewline stderr "."
puts -nonewline stderr "p"
set did_skip 1
if {$is_interesting} {
puts stderr "$modulefile [$event targetset_source_changes]"
@ -893,7 +893,7 @@ namespace eval punk::mix::cli {
if {$is_interesting} {
puts stdout "skipping module $current_source_dir/$m - no change in sources detected"
}
puts -nonewline stderr "."
puts -nonewline stderr "m"
set did_skip 1
#set file_record [punkcheck::installfile_skipped_install $basedir $file_record]
$event targetset_end SKIPPED
@ -935,7 +935,7 @@ namespace eval punk::mix::cli {
#set file_record [punkcheck::installfile_finished_install $basedir $file_record]
$event targetset_end OK -note "already versioned module"
} else {
puts -nonewline stderr "."
puts -nonewline stderr "f"
set did_skip 1
if {$is_interesting} {
puts stderr "$current_source_dir/$m [$event targetset_source_changes]"
@ -951,7 +951,8 @@ namespace eval punk::mix::cli {
if {$CALLDEPTH >= $max_depth} {
set subdirs [list]
} else {
set subdirs [glob -nocomplain -dir $current_source_dir -type d -tail *]
set subdirs [glob -nocomplain -dir $current_source_dir -type d -tail *]
set targets_existing [glob -nocomplain -dir $target_module_dir -type d -tail {*}$subdirs]
}
#puts stderr "subdirs: $subdirs"
foreach d $subdirs {
@ -965,7 +966,10 @@ namespace eval punk::mix::cli {
if {$skipdir} {
continue
}
if {![file exists $target_module_dir/$d]} {
#if {![file exists $target_module_dir/$d]} {
# file mkdir $target_module_dir/$d
#}
if {$d ni $targets_existing} {
file mkdir $target_module_dir/$d
}
lappend module_list {*}[build_modules_from_source_to_base $srcdir $basedir\

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

@ -26,8 +26,10 @@ namespace eval punk::mix::commandset::module {
namespace export *
proc paths {} {
set roots [punk::repo::find_repos ""]
set project [lindex [dict get $roots project] 0]
#set roots [punk::repo::find_repos ""]
#set project [lindex [dict get $roots project] 0]
set project [punk::repo::find_project ""]
if {$project ne ""} {
set is_project 1
set searchbase $project

10
src/modules/punk/mix/commandset/project-999999.0a1.0.tm

@ -664,7 +664,7 @@ namespace eval punk::mix::commandset::project {
sqlite3 dbp $dbfile
dbp eval {select name,value from config where name like 'project-%';} r {
if {$r(name) eq "project-name"} {
set project_name $r(value)
set project_name $r(value)
} elseif {$r(name) eq "project-code"} {
set project_code $r(value)
} elseif {$r(name) eq "project-description"} {
@ -1032,6 +1032,7 @@ namespace eval punk::mix::commandset::project {
set path [string trim [string range $pr 5 end]]
set nm [file rootname [file tail $path]]
set ckouts [fosconf eval {select name from global_config where value = $path;}]
#list of entries like "ckout:C:/buildtcl/2024zig/tcl90/"
set checkout_paths [list]
#strip "ckout:"
foreach ck $ckouts {
@ -1056,8 +1057,6 @@ namespace eval punk::mix::commandset::project {
}
@ -1067,11 +1066,6 @@ namespace eval punk::mix::commandset::project {
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Ready
package provide punk::mix::commandset::project [namespace eval punk::mix::commandset::project {

26
src/modules/punk/mix/commandset/repo-999999.0a1.0.tm

@ -24,6 +24,9 @@
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval punk::mix::commandset::repo {
namespace export *
variable PUNKARGS
proc tickets {{project ""}} {
#todo
set result ""
@ -52,9 +55,9 @@ namespace eval punk::mix::commandset::repo {
set repopaths [punk::repo::find_repos [pwd]]
set repos [dict get $repopaths repos]
if {![llength $repos]} {
append result [dict get $repopaths warnings]
append result [a+ bold yellow][dict get $repopaths warnings][a]
} else {
append result [dict get $repopaths warnings]
append result [a+ bold yellow][dict get $repopaths warnings][a]
lassign [lindex $repos 0] repopath repotypes
if {"fossil" in $repotypes} {
append result \n "Fossil repo based at $repopath"
@ -69,6 +72,17 @@ namespace eval punk::mix::commandset::repo {
}
return $result
}
#punk::args
lappend PUNKARGS [list {
@id -id ::punk::mix::commandset::repo::fossil-move-repository
@cmd -name punk::mix::commandset::repo::fossil-move-repository -help\
"Move the fossil repository file (usually named with .fossil extension).
This is an interactive function which will prompt for answers on stdin
before proceeding.
The move can be done even if there are open checkouts and will maintain
the link between checkout databases and the repository file."
}]
proc fossil-move-repository {{path ""}} {
set searchbase [pwd]
set projectinfo [punk::repo::find_repos $searchbase]
@ -402,10 +416,10 @@ namespace eval punk::mix::commandset::repo {
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::mix::commandset::repo
}

13
src/modules/punk/mix/templates/layouts/project/src/make.tcl

@ -314,7 +314,7 @@ if {$::punkmake::command eq "vendor"} {
}
# -- --- --- --- --- ---
} else {
puts -nonewline stderr "."
puts -nonewline stderr "v"
$installation_event targetset_end SKIPPED
}
$installation_event end
@ -409,7 +409,7 @@ if {$::punkmake::command eq "bootsupport"} {
}
# -- --- --- --- --- ---
} else {
puts -nonewline stderr "."
puts -nonewline stderr "b"
$boot_event targetset_end SKIPPED
}
$boot_event end
@ -589,7 +589,7 @@ foreach layoutbase $layout_bases {
}
# -- --- --- --- --- ---
} else {
puts stderr "."
puts stderr "skipping unchanged layout $layoutname"
$tpl_event targetset_end SKIPPED
}
}
@ -658,7 +658,7 @@ if {[punk::repo::is_fossil_root $projectroot]} {
}
# -- --- --- --- --- ---
} else {
puts stderr "."
puts stderr "skipping unchanged .fossil-custom/mainmenu"
$event targetset_end SKIPPED
}
$event end
@ -803,7 +803,7 @@ foreach runtimefile $runtimes {
}
# -- --- --- --- --- ---
} else {
puts stderr "."
puts stderr "skipping unchanged runtime $runtimefile"
$event targetset_end SKIPPED
}
$event end
@ -1064,8 +1064,7 @@ foreach vfs $vfs_folders {
} else {
set skipped_vfs_build 1
puts stderr "."
puts stdout "Skipping build for vfs $vfs with runtime $rtname - no change detected"
puts stderr "Skipping build for vfs $vfs with runtime $rtname - no change detected"
$vfs_event targetset_end SKIPPED
}
$vfs_event destroy

7
src/modules/punk/mod-0.1.tm

@ -76,7 +76,7 @@ namespace eval punk::mod::cli {
set sorted_versions [lsort $versions]
set latest [lindex $sorted_versions 0]
if {$latest eq "" && [llength $sorted_versions] > 1} {
set latest [lindex $sorted_versions 1
set latest [lindex $sorted_versions 1]
}
dict set appinfo latest $latest
@ -155,9 +155,8 @@ namespace eval punk::mod::cli {
}
package provide punk::mod [namespace eval punk::mod {
variable version
set version 0.1
variable version
set version 0.1
}]

15
src/modules/punk/netbox-999999.0a1.0.tm

@ -372,7 +372,7 @@ tcl::namespace::eval punk::netbox {
if {"tokentail" in $fields} {
#computed column
if {[dict exists $contextinfo token]} {
set tokentail [string range [dict get $contextinfo token] end-5 end]
set tokentail [string range [dict get $contextinfo token value] end-5 end]
}
}
set rowdata [list $k]
@ -405,7 +405,7 @@ tcl::namespace::eval punk::netbox {
if {"tokentail" in $fields} {
#computed column
if {[dict exists $contextinfo token]} {
set tokentail [string range [dict get $contextinfo token] end-5 end]
set tokentail [string range [dict get $contextinfo token value] end-5 end]
}
}
dict set result $k {} ;#ensure record is output even if empty fieldlist
@ -1144,12 +1144,12 @@ tcl::namespace::eval punk::netbox {
proc default_topics {} {return [list Description *]}
# -------------------------------------------------------------
# get_topic_ functions add more to auto-include in about topics
# get_topic_ functions add more to auto-include in about topicg
# -------------------------------------------------------------
proc get_topic_Description {} {
punk::args::lib::tstr [string trim {
package punk::netbox
description to come..
A library for calling netbox REST functions
} \n]
}
proc get_topic_License {} {
@ -1169,11 +1169,10 @@ tcl::namespace::eval punk::netbox {
}
return $contributors
}
proc get_topic_custom-topic {} {
proc get_topic_features {} {
punk::args::lib::tstr -return string {
A custom
topic
etc
netbox /status/ endpoint
beginnings of /ipam/ endpoints
}
}
# -------------------------------------------------------------

21
src/modules/punk/path-999999.0a1.0.tm

@ -657,6 +657,7 @@ namespace eval punk::path {
**/_aside (exlude files where _aside is last segment)
**/_aside/* (exclude folders one below an _aside folder)
**/_aside/** (exclude all folders with _aside as a segment)"
-antiglob_files -default {}
@values -min 0 -max -1 -optional 1 -type string
tailglobs -default * -multiple 1 -help\
"Patterns to match against filename portion (last segment) of each file path
@ -681,6 +682,7 @@ namespace eval punk::path {
set tailglobs [dict get $values tailglobs]
# -- --- --- --- --- --- ---
set opt_antiglob_paths [dict get $opts -antiglob_paths]
set opt_antiglob_files [dict get $opts -antiglob_files]
set CALLDEPTH [dict get $opts -call-depth-internal]
# -- --- --- --- --- --- ---
# -- --- --- --- --- --- ---
@ -718,7 +720,24 @@ namespace eval punk::path {
puts stderr "treefilenames error while listing files in dir $opt_dir\n $matches"
set dirfiles [list]
} else {
set dirfiles [lsort $matches]
set retained [list]
if {[llength $opt_antiglob_files]} {
foreach m $matches {
set skip 0
set ftail [file tail $m]
foreach anti $opt_antiglob_files {
if {[string match $anti $ftail]} {
set skip 1; break
}
}
if {!$skip} {
lappend retained $m
}
}
} else {
set retained $matches
}
set dirfiles [lsort $retained]
}
lappend files {*}$dirfiles

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

@ -3091,13 +3091,12 @@ namespace eval repl {
set v [lindex $versions end]
set path [lindex [package ifneeded $pkg $v] end]
if {[file extension $path] in {.tcl .tm}} {
if {[file exists $path]} {
set data [readFile $path]
if {![catch {readFile $path} data]} {
code eval [list info script $path]
code eval $data
code eval [list info script $prior_infoscript]
} else {
error "safe - failed to find $path"
error "safe - failed to read $path"
}
} else {
error "safe - refusing to attempt load of $pkg from $path - (allowed extensions .tcl .tm)"

132
src/modules/punk/repo-999999.0a1.0.tm

@ -128,8 +128,7 @@ namespace eval punk::repo {
lappend PUNKARGS [list {
@dynamic
@id -id "::punk::repo::fossil_proxy diff"
@cmd -name "fossil diff" -help "fossil diff
"
@cmd -name "fossil diff" -help "fossil diff"
@argdisplay -header "fossil help diff" -body {${[runout -n fossil help diff]}}
} ""]
lappend PUNKARGS [list {
@ -170,7 +169,7 @@ namespace eval punk::repo {
if {$fossilcmd ni $no_prompt_commands} {
set fossilrepos [dict get $repostate fossil]
if {[llength $fossilrepos] > 1} {
puts stdout [dict get $repostate warnings]
puts stdout [punk::ansi::a+ bold yellow][dict get $repostate warnings][punk::ansi::a]
puts stdout "Operating on inner fossil repository: [lindex $fossilrepos 0]"
puts stdout "Use FOSSIL instead of fossil to avoid this prompt and warning"
set answer [askuser "Are you sure you want to perform the operation on this repo? Y/N"]
@ -217,7 +216,7 @@ namespace eval punk::repo {
}
} elseif {$fossilcmd in [list "info" "status"]} {
#emit warning whether or not multiple fossil repos
puts stdout [dict get $repostate warnings]
puts stdout [punk::ansi::a+ bold yellow][dict get $repostate warnings][punk::ansi::a]
}
set fossil_prog [Cached_auto_execok fossil]
if {$fossil_prog ne ""} {
@ -330,12 +329,31 @@ namespace eval punk::repo {
}
}
}
lappend PUNKARGS [list {
@id -id "::punk::repo::find_project"
@cmd -name "punk::repo::find_project" -help\
"Find and return the path for the root of
the project to which the supplied path belongs.
If the supplied path is empty, the current
working directory is used as the starting point
for the upwards search.
Returns nothing if there is no project at or
above the specified path."
@values -min 0 -max 1
path -optional 1 -default "" -help\
"May be an absolute or relative path.
The full specified path doesn't have
to exist. The code will walk upwards
along the segments of the supplied path
testing the result of 'is_project_root'."
}]
proc find_project {{path {}}} {
if {$path eq {}} { set path [pwd] }
scanup $path is_project_root
}
proc is_fossil_root {{path {}}} {
#detect if path is a fossil root - without consulting fossil databases
proc is_fossil_root2 {{path {}}} {
if {$path eq {}} { set path [pwd] }
#from kettle::path::is.fossil
foreach control {
@ -348,20 +366,51 @@ namespace eval punk::repo {
}
return 0
}
proc is_fossil_root {{path {}}} {
#much faster on windows than 'file exists' checks
if {$path eq {}} { set path [pwd] }
set control [list _FOSSIL_ .fslckout .fos]
#could be marked 'hidden' on windows
if {"windows" eq $::tcl_platform(platform)} {
set files [list {*}[glob -nocomplain -dir $path -types f -tail {*}$control] {*}[glob -nocomplain -dir $path -types {f hidden} -tail {*}$control]]
} else {
set files [glob -nocomplain -dir $path -types f -tail {*}$control]
}
expr {[llength $files] > 0}
}
#review - is a .git folder sufficient?
#consider git rev-parse --git-dir ?
proc is_git_root {{path {}}} {
if {$path eq {}} { set path [pwd] }
set control [file join $path .git]
expr {[file exists $control] && [file isdirectory $control]}
#set control [file join $path .git]
#expr {[file exists $control] && [file isdirectory $control]}
if {"windows" eq $::tcl_platform(platform)} {
#:/
#globbing for dotfiles in tcl is problematic across platforms - windows 'hidden' concept is independent
#we need to find .git whether hidden or not - so need 2 glob operations
#.git may or may not be set with windows 'hidden' attribute
set hiddengitdir [glob -nocomplain -dir $path -types {d hidden} -tail .git]
set nonhiddengitdir [glob -nocomplain -dir $path -types {d} -tail .git] ;#won't return hidden :/
return [expr {[llength [list {*}$hiddengitdir {*}$nonhiddengitdir]] > 0}]
} else {
#:/
#unix returns 'hidden' files even without the hidden type being specified - but only if the pattern explicitly matches
return [expr {[llength [glob -nocomplain -dir $path -types d -tail .git]] > 0}] ;#will return .git even though it is conventionally 'hidden' on unix :/
}
}
proc is_repo_root {{path {}}} {
if {$path eq {}} { set path [pwd] }
expr {[is_fossil_root $path] || [is_git_root $path]}
#expr {[is_fossil_root $path] || [is_git_root $path]}
expr {[is_git_root $path] || [is_fossil_root $path]} ;#is_git_root has less to check
}
#require a minimum of src and src/modules|src/scriptapps|src/*/*.vfs - and that it's otherwise sensible
#we still run a high chance of picking up unintended candidates - but hopefully it's a reasonable balance.
#after excluding undesirables;
#require a minimum of
# - (src and src/modules|src/scriptapps|src/vfs)
# - OR (src and punkproject.toml)
# - and that it's otherwise sensible
#we still run a chance of picking up unintended candidates - but hopefully it's a reasonable balance.
proc is_candidate_root {{path {}}} {
if {$path eq {}} { set path [pwd] }
if {[file pathtype $path] eq "relative"} {
@ -380,24 +429,34 @@ namespace eval punk::repo {
}
#review - adjust to allow symlinks to folders?
foreach required {
src
} {
set req $path/$required
if {(![file exists $req]) || ([file type $req] ne "directory") } {return 0}
#foreach required {
# src
#} {
# set req $path/$required
# if {(![file exists $req]) || ([file type $req] ne "directory") } {return 0}
#}
set required [list src]
set found_required [glob -nocomplain -dir $path -types d -tails {*}$required]
if {[llength $found_required] < [llength $required]} {
return 0
}
set src_subs [glob -nocomplain -dir $path/src -types d -tail *]
#test for $path/src/lib is too common to be a useful indicator
if {"modules" in $src_subs || "scriptapps" in $src_subs} {
if {"modules" in $src_subs || "vfs" in $src_subs || "scriptapps" in $src_subs} {
#bare minimum 1
return 1
}
foreach sub $src_subs {
if {[string match *.vfs $sub]} {
return 1
}
#bare minimum2
# - has src folder and (possibly empty?) punkproject.toml
if {[file exists $path/punkproject.toml]} {
return 1
}
#review - do we need to check if path is already within a project?
#can we have a nested project? Seems like asking for complexity and problems when considering possible effects for git/fossil
#todo - breadth first search with depth limit (say depth 3?) for *.tm or *.tcl as another positive qualifier for this dir to be a project-root
#we probably don't want to deep search a src folder in case the user is accidentally in some other type of project's tree
#such a src tree could be very large, so if we don't find tcl indicators near the root it's a good bet this isn't a candidate
@ -417,9 +476,17 @@ namespace eval punk::repo {
proc is_project_root {path} {
#review - find a reliable simple mechanism. Noting we have projects based on different templates.
#Should there be a specific required 'project' file of some sort?
#(punkproject.toml is a candidate)
#we don't want to solely rely on such a file being present
# - we may also have punkproject.toml in project_layout template folders for example
#test for file/folder items indicating fossil or git workdir base
if {(![punk::repo::is_fossil_root $path]) && (![punk::repo::is_git_root $path])} {
#the 'dev' mechanism for creating projects automatically creates a fossil project
#(which can be ignored if the user wants to manage it with git - but should probably remain in place? review)
#however - we currently require that for it to be a 'project' there must be some version control.
#REVIEW.
#
if {![punk::repo::is_repo_root $path]} {
return 0
}
#exclude some known places we wouldn't want to put a project
@ -846,6 +913,7 @@ namespace eval punk::repo {
#determine nature of possibly-nested repositories (of various types) at and above this path
#Treat an untracked 'candidate' folder as a sort of repository
proc find_repos {path} {
puts "find_repos '$path'"
set start_dir $path
#root is a 'project' if it it meets the candidate requrements and is under repo control
@ -860,6 +928,10 @@ namespace eval punk::repo {
while {[string length [set fosroot [punk::repo::find_fossil $fos_search_from]]]} {
lappend fossils_bottom_to_top $fosroot
set fos_search_from [file dirname $fosroot]
if {$fos_search_from eq $fosroot} {
#root of filesystem is repo - unusual case - but without this we would never escape the while loop
break
}
}
dict set root_dict fossil $fossils_bottom_to_top
@ -868,6 +940,9 @@ namespace eval punk::repo {
while {[string length [set gitroot [punk::repo::find_git $git_search_from]]]} {
lappend gits_bottom_to_top $gitroot
set git_search_from [file dirname $gitroot]
if {$git_search_from eq $gitroot} {
break
}
}
dict set root_dict git $gits_bottom_to_top
@ -876,6 +951,9 @@ namespace eval punk::repo {
while {[string length [set candroot [punk::repo::find_candidate $cand_search_from]]]} {
lappend candidates_bottom_to_top $candroot
set cand_search_from [file dirname $candroot]
if {$cand_search_from eq $candroot} {
break
}
}
dict set root_dict candidate $candidates_bottom_to_top
@ -938,12 +1016,12 @@ namespace eval punk::repo {
}
set closest_fossil [lindex [dict get $root_dict fossil] 0]
set closest_fossil_len [llength [file split $closest_fossil]]
set closest_git [lindex [dict get $root_dict git] 0]
set closest_git_len [llength [file split $closest_git]]
set closest_candidate [lindex [dict get $root_dict candidate] 0]
set closest_candidate_len [llength [file split $closest_candidate]]
set closest_fossil [lindex [dict get $root_dict fossil] 0]
set closest_fossil_len [llength [file split $closest_fossil]]
set closest_git [lindex [dict get $root_dict git] 0]
set closest_git_len [llength [file split $closest_git]]
set closest_candidate [lindex [dict get $root_dict candidate] 0]
set closest_candidate_len [llength [file split $closest_candidate]]
if {$closest_candidate_len > $closest_fossil_len && $closest_candidate_len > $closest_git_len} {
#only warn if this candidate is *within* a found repo root

114
src/modules/punkcheck-0.1.0.tm

@ -243,12 +243,14 @@ namespace eval punkcheck {
}
method get_targets_exist {} {
set punkcheck_folder [file dirname [$o_installer get_checkfile]]
set existing [list]
foreach t $o_targets {
if {[file exists [file join $punkcheck_folder $t]]} {
lappend existing $t
}
}
set existing [glob -nocomplain -dir $punkcheck_folder -tails {*}$o_targets]
#set existing [list]
#foreach t $o_targets {
# if {[file exists [file join $punkcheck_folder $t]]} {
# lappend existing $t
# }
#}
return $existing
}
method end {} {
@ -880,19 +882,46 @@ namespace eval punkcheck {
#allow nonexistant as a source
set fpath [file join $punkcheck_folder $source_relpath]
if {![file exists $fpath]} {
#windows: file exist + file type = 2ms vs 500ms for 2x glob
set floc [file dirname $fpath]
set fname [file tail $fpath]
set file_set [glob -nocomplain -dir $floc -type f -tails $fname]
set dir_set [glob -nocomplain -dir $floc -type d -tails $fname]
set link_set [glob -nocomplain -dir $floc -type l -tails $fname]
if {[llength $file_set] == 0 && [llength $dir_set] == 0 && [llength $link_set] == 0} {
#could also theoretically exist as less common types, b,c,p,s (block,char,pipe,socket)
#- we don't expect them here - REVIEW - ever possible?
#- installing/examining such things an unlikely usecase and would require special handling anyway.
set ftype "missing"
set fsize ""
} else {
set ftype [file type $fpath]
if {$ftype eq "directory"} {
if {[llength $dir_set]} {
set ftype "directory"
set fsize "NA"
} elseif {[llength $link_set]} {
set ftype "link"
set fsize 0
} else {
set ftype "file"
#todo - optionally use mtime instead of cksum (for files only)?
#mtime is not reliable across platforms and filesystems though.. see article linked at top.
set fsize [file size $fpath]
}
}
#if {![file exists $fpath]} {
# set ftype "missing"
# set fsize ""
#} else {
# set ftype [file type $fpath]
# if {$ftype eq "directory"} {
# set fsize "NA"
# } else {
# #todo - optionally use mtime instead of cksum (for files only)?
# #mtime is not reliable across platforms and filesystems though.. see article linked at top.
# set fsize [file size $fpath]
# }
#}
#get_relativecksum_from_base and fill_relativecksums_from_base_and_relativepathdict will set cksum to <PATHNOTFOUND> if fpath doesn't exist
if {$use_cache} {
set source_cksum_info [punk::mix::base::lib::fill_relativecksums_from_base_and_relativepathdict $punkcheck_folder [dict create $source_relpath $use_cache_record]]
@ -1648,6 +1677,10 @@ namespace eval punkcheck {
set is_skip 0
if {$overwrite_what eq "all-targets"} {
file mkdir $current_target_dir
#--------------------------------------------
#sometimes we get the error: 'error copying "file1" to "file2": invalid argument'
#--------------------------------------------
puts stderr "punkcheck: about to: file copy -force $current_source_dir/$m $current_target_dir"
file copy -force $current_source_dir/$m $current_target_dir
lappend files_copied $current_source_dir/$m
} else {
@ -1859,22 +1892,75 @@ namespace eval punkcheck {
return [list files_copied $files_copied files_skipped $files_skipped sources_unchanged $sources_unchanged antiglob_paths_matched $antiglob_paths_matched punkcheck_records $punkcheck_records punkcheck_folder $punkcheck_folder srcdir $srcdir tgtdir $tgtdir]
}
proc summarize_install_resultdict {resultdict} {
lappend PUNKARGS [list {
@id -id ::punkcheck::summarize_install_resultdict
@cmd -name punkcheck::summarize_install_resultdict -help\
"Emits a string summarizing a punkcheck resultdict, showing
how many items were copied, and the source, target locations"
@opts
-title -type string -default ""
-forcecolour -type boolean -default 0 -help\
"When true, passes the forcecolour tag to punk::ansi functions.
This enables ANSI sgr colours even when colour
is off. (ignoring env(NO_COLOR))
To disable colour - ensure the NO_COLOR env var is set,
or use:
namespace eval ::punk::console {variable colour_disabled 1}"
@values -min 1 -max 1
resultdict -type dict
}]
proc summarize_install_resultdict {args} {
set argd [punk::args::parse $args withid ::punkcheck::summarize_install_resultdict]
lassign [dict values $argd] leaders opts values received
set title [dict get $opts -title]
set forcecolour [dict get $opts -forcecolour]
set resultdict [dict get $values resultdict]
set has_ansi [expr {![catch {package require punk::ansi}]}]
if {$has_ansi} {
if {$forcecolour} {
set fc "forcecolour"
} else {
set fc ""
}
set R [punk::ansi::a] ;#reset
set LINE_COLOUR [punk::ansi::a+ {*}$forcecolour bold cyan]
set LOW_COLOUR [punk::ansi::a+ {*}$forcecolour bold green]
set HIGH_COLOUR [punk::ansi::a+ {*}$forcecolour bold yellow]
} else {
set R ""
set LINE_COLOUR ""
set LOW_COLOUR ""
set HIGH_COLOUR ""
}
set msg ""
if {[dict size $resultdict]} {
set copied [dict get $resultdict files_copied]
append msg "--------------------------" \n
append msg "[dict keys $resultdict]" \n
if {[llength $copied] == 0} {
set HIGHLIGHT $LOW_COLOUR
} else {
set HIGHLIGHT $HIGH_COLOUR
}
set ruler $LINE_COLOUR[string repeat - 78]$R
if {$title ne ""} {
append msg $ruler \n
append msg $title \n
}
append msg $ruler \n
#append msg "[dict keys $resultdict]" \n
set tgtdir [dict get $resultdict tgtdir]
set checkfolder [dict get $resultdict punkcheck_folder]
append msg "Copied [llength $copied] files from [dict get $resultdict srcdir] to [dict get $resultdict tgtdir]" \n
append msg "${HIGHLIGHT}Copied [llength $copied] files from [dict get $resultdict srcdir] to [dict get $resultdict tgtdir]$R" \n
foreach f $copied {
append msg "COPIED [punkcheck::lib::path_relative $checkfolder $f]" \n
append msg " TO $tgtdir" \n
}
append msg "[llength [dict get $resultdict sources_unchanged]] unchanged source files" \n
append msg "[llength [dict get $resultdict files_skipped]] skipped files" \n
append msg "--------------------------" \n
append msg $ruler \n
}
return $msg
}

2
src/vendormodules/commandstack-0.3.tm

@ -259,7 +259,7 @@ namespace eval commandstack {
variable debug
if $debug {
if {$debug} {
if {[dict exists $all_stacks $command]} {
set stack [dict get $all_stacks $command]
puts stderr "(commandstack::rename_command) Subsequent rename of command '$command'. (previous renames: [llength $stack]). Renaming to [dict get $nextinfo next_target]"

21
src/vendormodules/fauxlink-0.1.1.tm

@ -20,7 +20,7 @@
#[manpage_begin fauxlink_module_fauxlink 0 0.1.1]
#[copyright "2024"]
#[titledesc {faux link application shortcuts}] [comment {-- Name section and table of contents description --}]
#[moddesc {fauxlink .fxlnk}] [comment {-- Description at end of page heading --}]
#[moddesc {.fauxlink .fxlnk}] [comment {-- Description at end of page heading --}]
#[require fauxlink]
#[keywords symlink faux fake shortcut toml]
#[description]
@ -29,18 +29,19 @@
#[para] A solution is required for application-driven filesystem links that survives cross platform moves as well as
#[para] archiving and packaging systems.
#[para] The target is specified in a minimally-encoded form in the filename itself - but still human readable.
#[para] format of name <nominalname>#<encodedtarget>.fxlnk
#[para] format of name <nominalname>#<encodedtarget>.fauxlink
#[para] where <nominalname> can be empty - then the effective nominal name is the tail of the <encodedtarget>
#[para] The file extension must be .fauxlink or .fxlnk
#[para] The + symbol substitutes for forward-slashes.
#[para] Other chars can be encoded using url-like encoding - (but only up to %7E !)
#[para] We deliberately treat higher % sequences literally.
#[para] This means actual uri::urn encoded unicode sequences (e.g %E2%99%A5 [lb]heart[rb]) can remain literal for linking to urls.
#[para] e.g if an actual + or # is required in a filename or path segment they can be encoded as %2B & %23
#[para] e.g a link to a file file#A.txt in parent dir could be:
#[para] file%23A.txt#..+file%23A.txt.fxlnk
#[para] or equivalently (but obviously affecting sorting) #..+file%23A.txt.fxlnk
#[para] file%23A.txt#..+file%23A.txt.fauxlink
#[para] or equivalently (but obviously affecting sorting) #..+file%23A.txt.fauxlink
#[para] The <nominalname> can be unrelated to the actual target
#[para] e.g datafile.dat#..+file%23A.txt.fxlnk
#[para] e.g datafile.dat#..+file%23A.txt.fauxlink
#[para] This system has no filesystem support - and must be completely application driven.
#[para] This can be useful for example in application test packages which may be tarred or zipped and moved cross platform.
#[para] The target being fully specified in the name means the file doesn't have to be read for the target to be determined
@ -63,9 +64,9 @@
#https://learn.microsoft.com/en-us/troubleshoot/windows-client/networking/url-encoding-unc-paths-not-url-decoded
# ie "//server/c/Program files" works but "//server/c/Program%20Files" is now treated by windows as a literal path with %20 in it.
#Using fauxlink - a link would be:
# "my-program-files#++server+c+Program%20Files.fxlnk"
# "my-program-files#++server+c+Program%20Files.fauxlink"
#If we needed the old-style literal %20 it would become
# "my-program-files#++server+c+Program%2520Files.fxlnk"
# "my-program-files#++server+c+Program%2520Files.fauxlink"
#
# The file:// scheme on windows supposedly *does* decode %xx (for use in a browser)
# e.g
@ -296,12 +297,12 @@ namespace eval fauxlink {
set is_fauxlink 0
#we'll process anyway - but return the result wrapped
#This should allow deliberate erroring for the calling dict user if the extension difference is inadvertent
#(e.g blindly processing all files in a folder that is normally only .fxlnk files - but then something added that happens
#(e.g blindly processing all files in a folder that is normally only .fauxlink files - but then something added that happens
# to have # characters in it)
#It also means if someone really wants to use the fauxlink semantics on a different file type
# - they can - but just have to access the results differently and take that (minor) risk.
#error "fauxlink::resolve refusing to process link $link - file extension must be .fxlnk or .fauxlink"
set err_extra "\nnonstandard extension '$extension_name' for fauxlink. Check that the call to fauxlink::resolve was deliberate"
set err_extra "\nnonstandard extension '$extension_name' for fauxlink. (expected .fxlnk or .fauxlink) Check that the call to fauxlink::resolve was deliberate"
} else {
set is_fauxlink 1
set err_extra ""
@ -318,7 +319,7 @@ namespace eval fauxlink {
#if there are 4 parts - the 3rd part is a tagset where each tag begins with @
#and each subsequent part is a comment. Empty comments are stripped from the comments list
#A tagset can be empty - but if it's not empty it must contain at least one @ and must start with @
#e.g name.txt#path#@tag1@tag2#test###.fxlnk
#e.g name.txt#path#@tag1@tag2#test###.fauxlink
#has a name, a target, 2 tags and one comment
#check namespec already has required chars encoded

1
src/vendormodules/include_modules.config

@ -11,6 +11,7 @@ set local_modules [list\
c:/repo/jn/tclmodules/tablelist/modules tablelist\
c:/repo/jn/tclmodules/tablelist/modules tablelist_tile\
c:/repo/jn/tclmodules/tomlish/modules tomlish\
c:/repo/jn/tclmodules/tomlish/modules test::tomlish\
]
set fossil_modules [dict create\

BIN
src/vendormodules/packageTest-0.1.1.tm

Binary file not shown.

BIN
src/vendormodules/test/tomlish-1.1.1.tm

Binary file not shown.

BIN
src/vendormodules/test/tomlish-1.1.3.tm

Binary file not shown.

160
src/vendormodules/tomlish-1.1.2.tm

@ -185,6 +185,8 @@ namespace eval tomlish {
error "tomlish _get_keyval_value invalid to have type TABLE on rhs of ="
}
ITABLE {
#This one should not be returned as a type <tag> value <something> structure!
#
set result [::tomlish::to_dict [list $found_sub]]
}
ARRAY {
@ -249,6 +251,7 @@ namespace eval tomlish {
}
#to_dict is a *basic* programmatic datastructure for accessing the data.
# produce a dictionary of keys and values from a tomlish tagged list.
# to_dict is primarily for reading toml data.
@ -271,8 +274,12 @@ namespace eval tomlish {
# so we can raise an error to satisfy the toml rule: 'You cannot define any key or table more than once. Doing so is invalid'
#Note that [a] and then [a.b] is ok if there are no subkey conflicts - so we are only tracking complete tablenames here.
#we don't error out just because a previous tablename segment has already appeared.
variable tablenames_seen [list]
##variable tablenames_seen [list]
if {[uplevel 1 [list info exists tablenames_seen]]} {
upvar tablenames_seen tablenames_seen
} else {
set tablenames_seen [list]
}
log::info ">>> processing '$tomlish'<<<"
set items $tomlish
@ -311,9 +318,9 @@ namespace eval tomlish {
}
DOTTEDKEY {
log::debug "--> processing $tag: $item"
set dkey_info [_get_dottedkey_info $item]
set dotted_key_hierarchy [dict get $dkey_info keys]
set dotted_key_hierarchy_raw [dict get $dkey_info keys_raw]
set dkey_info [_get_dottedkey_info $item]
set dotted_key_hierarchy [dict get $dkey_info keys]
set dotted_key_hierarchy_raw [dict get $dkey_info keys_raw]
#a.b.c = 1
#table_key_hierarchy -> a b
@ -345,6 +352,9 @@ namespace eval tomlish {
set keyval_dict [_get_keyval_value $item]
dict set datastructure {*}$pathkeys $leafkey $keyval_dict
#JMN test 2025
}
TABLE {
set tablename [lindex $item 1]
@ -386,8 +396,40 @@ namespace eval tomlish {
lappend table_key_hierarchy_raw $rawseg
if {[dict exists $datastructure {*}$table_key_hierarchy]} {
#It's ok for this key to already exist *if* it was defined by a previous tablename,
# but not if it was defined as a key/qkey/skey ?
#It's ok for this key to already exist *if* it was defined by a previous tablename or equivalent
#and if this key is longer
#consider the following 2 which are legal:
#[table]
#x.y = 3
#[table.x.z]
#k= 22
#equivalent
#[table]
#[table.x]
#y = 3
#[table.x.z]
#k=22
#illegal
#[table]
#x.y = 3
#[table.x.y.z]
#k = 22
## - we should bfail on encoungerint table.x.y because only table and table.x are effectively tables
## - we should also fail if
#illegal
#[table]
#x.y = {p=3}
#[table.x.y.z]
#k = 22
## we should fail because y is an inline table which is closed to further entries
#TODO! fix - this code is wrong
set testkey [join $table_key_hierarchy_raw .]
@ -422,7 +464,7 @@ namespace eval tomlish {
if {$found_testkey == 0} {
#the raw table_key_hierarchy is better to display in the error message, although it's not the actual dict keyset
set msg "key [join $table_key_hierarchy_raw .] already exists in datastructure, but wasn't defined by a supertable."
append msg "tablenames_seen:"
append msg \n "tablenames_seen:" \n
foreach ts $tablenames_seen {
append msg " " $ts \n
}
@ -453,13 +495,18 @@ namespace eval tomlish {
#now add the contained elements
foreach element [lrange $item 2 end] {
set type [lindex $element 0]
log::debug "--> $type processing contained element $element"
switch -exact -- $type {
DOTTEDKEY {
set dkey_info [_get_dottedkey_info $element]
set dotted_key_hierarchy [dict get $dkey_info keys]
set dotted_key_hierarchy_raw [dict get $dkey_info keys_raw]
set leaf_key [lindex $dotted_key_hierarchy end]
set dkeys [lrange $dotted_key_hierarchy 0 end-1]
#e.g1 keys {x.y y} keys_raw {'x.y' y}
#e.g2 keys {x.y y} keys_raw {{"x.y"} y}
set dotted_key_hierarchy [dict get $dkey_info keys]
set dkeys [lrange $dotted_key_hierarchy 0 end-1]
set leaf_key [lindex $dotted_key_hierarchy end]
set dotted_key_hierarchy_raw [dict get $dkey_info keys_raw]
set dkeys_raw [lrange $dotted_key_hierarchy_raw 0 end-1]
set leaf_key_raw [lindex $dotted_key_hierarchy_raw end]
#ensure empty keys are still represented in the datastructure
set test_keys $table_keys
@ -476,7 +523,22 @@ namespace eval tomlish {
error "Duplicate key '$table_keys $dkeys $leaf_key'. The key already exists at this level in the toml data. The toml data is not valid."
}
set keyval_dict [_get_keyval_value $element]
#keyval_dict is either a {type <tomltag> value <whatever>}
#or the result from parsing an arbitrary dict from an inline table - which could theoretically look the same at the topmost level
#punk::dict::is_tomlish_typeval can distinguish
puts stdout ">>> $keyval_dict"
dict set datastructure {*}$table_keys {*}$dkeys $leaf_key $keyval_dict
#JMN 2025
#tomlish::utils::normalize_key ??
lappend tablenames_seen [join [list {*}$table_key_hierarchy_raw {*}$dkeys_raw] .] ;#????
#if the keyval_dict is not a simple type x value y - then it's an inline table ?
#if so - we should add the path to the leaf_key as a seen table too - as it's not allowed to have more entries added.
if {![tomlish::dict::is_tomlish_typeval $keyval_dict]} {
#the value is either empty or or a dict structure with arbitrary (from-user-data) toplevel keys
# inner structure will contain {type <tag> value <etc>} if all leaves are not empty ITABLES
lappend tablenames_seen [join [list {*}$table_key_hierarchy_raw {*}$dkeys_raw $leaf_key_raw] .]
}
}
KEY - QKEY - SQKEY {
#obsolete ?
@ -777,7 +839,7 @@ namespace eval tomlish {
set result [list]
set lastparent [lindex $parents end]
if {$lastparent in [list "" do_inline]} {
if {[tomlish::dict::is_tomltype $vinfo]} {
if {[tomlish::dict::is_tomlish_typeval $vinfo]} {
set type [dict get $vinfo type]
#treat ITABLE differently?
set sublist [_from_dictval_tomltype $parents $tablestack $keys $vinfo]
@ -811,7 +873,7 @@ namespace eval tomlish {
} else {
set VK_PART [list KEY $vk]
}
if {[tomlish::dict::is_tomltype $vv]} {
if {[tomlish::dict::is_tomlish_typeval $vv]} {
#type x value y
set sublist [_from_dictval_tomltype $parents $tablestack $keys $vv]
set record [list DOTTEDKEY [list $VK_PART {WS { }}] = {WS { }} $sublist]
@ -877,7 +939,7 @@ namespace eval tomlish {
}
} else {
#lastparent is not toplevel "" or "do_inline"
if {[tomlish::dict::is_tomltype $vinfo]} {
if {[tomlish::dict::is_tomlish_typeval $vinfo]} {
#type x value y
set sublist [_from_dictval_tomltype $parents $tablestack $keys $vinfo]
lappend result {*}$sublist
@ -901,7 +963,7 @@ namespace eval tomlish {
} else {
set VK_PART [list KEY $vk]
}
if {[tomlish::dict::is_tomltype $vv]} {
if {[tomlish::dict::is_tomlish_typeval $vv]} {
#type x value y
set sublist [_from_dictval_tomltype $parents $tablestack $keys $vv]
set record [list DOTTEDKEY [list $VK_PART] = $sublist]
@ -2404,7 +2466,8 @@ namespace eval tomlish::utils {
} ;#RS
#check if str is valid for use as a toml bare key
proc is_barekey {str} {
#Early toml versions? only allowed letters + underscore + dash
proc is_barekey1 {str} {
if {[tcl::string::length $str] == 0} {
return 0
} else {
@ -2418,6 +2481,52 @@ namespace eval tomlish::utils {
}
}
#from toml.abnf in github.com/toml-lang/toml
#unquoted-key = 1*unquoted-key-char
#unquoted-key-char = ALPHA / DIGIT / %x2D / %x5F ; a-z A-Z 0-9 - _
#unquoted-key-char =/ %xB2 / %xB3 / %xB9 / %xBC-BE ; superscript digits, fractions
#unquoted-key-char =/ %xC0-D6 / %xD8-F6 / %xF8-37D ; non-symbol chars in Latin block
#unquoted-key-char =/ %x37F-1FFF ; exclude GREEK QUESTION MARK, which is basically a semi-colon
#unquoted-key-char =/ %x200C-200D / %x203F-2040 ; from General Punctuation Block, include the two tie symbols and ZWNJ, ZWJ
#unquoted-key-char =/ %x2070-218F / %x2460-24FF ; include super-/subscripts, letterlike/numberlike forms, enclosed alphanumerics
#unquoted-key-char =/ %x2C00-2FEF / %x3001-D7FF ; skip arrows, math, box drawing etc, skip 2FF0-3000 ideographic up/down markers and spaces
#unquoted-key-char =/ %x2070-21FF / %x2300-24FF ; skip math operators
#unquoted-key-char =/ %x25A0-268B / %x2690-2757 ; skip box drawing, block elements, and some yin-yang symbols
#unquoted-key-char =/ %x2762-2767 / %x2776-27E5 ; skip some Dingbat punctuation
#unquoted-key-char =/ %x2801-297F ; skip some math brackets and arrows, and braille blank
#unquoted-key-char =/ %x2B00-2FFF / %x3001-D7FF ; skip various math operators and symbols, and ideographic space
#unquoted-key-char =/ %xF900-FDCF / %xFDF0-FFFD ; skip D800-DFFF surrogate block, E000-F8FF Private Use area, FDD0-FDEF intended for process-internal use (unicode)
#unquoted-key-char =/ %x10000-EFFFF ; all chars outside BMP range, excluding Private Use planes (F0000-10FFFF)
variable re_barekey
set ranges [list]
lappend ranges {a-zA-Z0-9\_\-}
lappend ranges {\u00B2} {\u00B3} {\u00B9} {\u00BC-\u00BE} ;# superscript digits, fractions
lappend ranges {\u00C0-\u00D6} {\u00D8-\u00F6} {\u00F8-\u037D} ;# non-symbol chars in Latin block
lappend ranges {\u037f-\u1FFF} ;# exclude GREEK QUESTION MARK, which is basically a semi-colon
lappend ranges {\u200C-\u200D} {\u203F-\u2040} ;# from General Punctuation Block, include the two tie symbols and ZWNJ, ZWJ
lappend ranges {\u2070-\u218f} {\u2460-\u24FF} ;# include super-subscripts, letterlike/numberlike forms, enclosed alphanumerics
lappend ranges {\u2C00-\u2FEF} {\u3001-\uD7FF} ;# skip arrows, math, box drawing etc, skip 2FF0-3000 ideographic up/down markers and spaces
lappend ranges {\u2070-\u21FF} {\u2300-\u24FF} ;# skip math operators
lappend ranges {\u25A0-\u268B} {\u2690-\u2757} ;# skip box drawing, block elements, and some yin-yang symbols
lappend ranges {\u2762-\u2767} {\u2776-\u27E5} ;# skip some Dingbat punctuation
lappend ranges {\u2801-\u297F} ;# skip some math brackets and arrows, and braille blank
lappend ranges {\u2B00-\u2FFF} {\u3001-\uD7FF} ;# skip various math operators and symbols, and ideographic space
lappend ranges {\uF900-\uFDCF} {\uFDF0-\uFFFD} ;# skip D800-DFFF surrogate block, E000-F8FF Private Use area, FDD0-FDEF intended for process-internal use (unicode)
lappend ranges {\U10000-\UEFFFF} ;# all chars outside BMP range, excluding Private Use planes (F0000-10FFFF)
set re_barekey {^[}
foreach r $ranges {
append re_barekey $r
}
append re_barekey {]+$}
proc is_barekey {str} {
if {[tcl::string::length $str] == 0} {
return 0
}
variable re_barekey
return [regexp $re_barekey $str]
}
#test only that the characters in str are valid for the toml specified type 'integer'.
proc int_validchars1 {str} {
set numchars [tcl::string::length $str]
@ -3471,7 +3580,7 @@ namespace eval tomlish::parse {
return 1
}
barekey {
error "tomlish Unexpected character '$c' during bare key. Only \[a-zA-Z_-\] allowed. [tomlish::parse::report_line]"
error "tomlish Unexpected character '$c' during bare key. Only \[a-zA-Z0-9_-\] and a selection of letter-like chars allowed (see tomlish::utils::is_barekey). [tomlish::parse::report_line]"
}
whitespace {
# hash marks end of whitespace token
@ -5222,7 +5331,7 @@ namespace eval tomlish::parse {
if {[tomlish::utils::is_barekey $c]} {
append tok $c
} else {
error "tomlish Unexpected character '$c' during bare key. Only \[a-zA-Z0-9_-\] allowed. [tomlish::parse::report_line]"
error "tomlish Unexpected character '$c' during bare key. Only \[a-zA-Z0-9_-\] and a selection of letter-like chars allowed. (see tomlish::utils::is_barekey) [tomlish::parse::report_line]"
}
}
starttablename - starttablearrayname {
@ -5354,10 +5463,15 @@ namespace eval tomlish::dict {
namespace export {[a-z]*}; # Convention: export all lowercase
namespace path [namespace parent]
proc is_tomltype {d} {
expr {[dict size $d] == 2 && [dict exists $d type] && [dict exists $d value]}
proc is_tomlish_typeval {d} {
#designed to detect {type <tag> value <whatever>} e.g {type INT value 3}, {type STRING value "blah etc"}
#as a sanity check we need to avoid mistaking user data that happens to match same form
#consider x.y={type="spud",value="blah"}
#The value of type will itself have already been converted to {type STRING value spud} ie never a single element.
#check the length of the type as a quick way to see it's a tag - not something else masqerading.
expr {[dict size $d] == 2 && [dict exists $d type] && [dict exists $d value] && [llength [dict get $d type]] == 1}
}
proc is_tomltype2 {d} {
proc is_tomlish_typeval2 {d} {
upvar ::tomlish::tags tags
expr {[lindex $d 0] eq "type" && [lindex $d 1] in $tags}
}
@ -5366,7 +5480,7 @@ namespace eval tomlish::dict {
set dictposn [expr {[dict size $d] -1}]
foreach k [lreverse [dict keys $d]] {
set dval [dict get $d $k]
if {[is_tomltype $dval]} {
if {[is_tomlish_typeval $dval]} {
set last_simple $dictposn
break
}

1484
src/vendormodules/tomlish-1.1.1.tm → src/vendormodules/tomlish-1.1.3.tm

File diff suppressed because it is too large Load Diff
Loading…
Cancel
Save