Browse Source
vendorupdate pulls tomlish 1.1.10 from a clean tomlish checkout: the library API punk::config will consume now carries punk::args (PUNKARGS) documentation - from_toml, to_dict, from_dict, to_toml, update_tomlish_from_dict - completing the G-014 precondition (documentation added upstream in the tomlish project, landed here by re-vendoring, never by editing src/vendormodules copies). 1.1.10 also carries the explicit tomlish::cmdline_main entry point (wrapped-exe startup fix; the load-time argv side effect is gone). vfscommonupdate refreshes the punkshell kit payload to the current built modules: shellfilter 0.2.3 (channel-restoration try/finally), shellrun 0.1.4, punkboot::utils 0.1.1, punk::console 0.7.1 content catch-up, and tomlish 1.1.10. Project version 0.2.7. Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.commaster
8 changed files with 19943 additions and 122 deletions
@ -1,3 +1,3 @@
|
||||
[project] |
||||
name = "punkshell" |
||||
version = "0.2.6" |
||||
version = "0.2.7" |
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,214 @@
|
||||
# -*- tcl -*- |
||||
# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-buildversion.txt |
||||
# |
||||
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. |
||||
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# (C) 2023 |
||||
# |
||||
# @@ Meta Begin |
||||
# Application punkboot::utils 0.1.1 |
||||
# Meta platform tcl |
||||
# Meta license BSD |
||||
# @@ Meta End |
||||
|
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Requirements |
||||
##e.g package require frobz |
||||
package require Tcl 8.6- |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
namespace eval punkboot::utils { |
||||
variable version 0.1.0 |
||||
namespace export parse_punkproject_version read_punkproject_version read_changelog_latest_version vcs_dirty_warnings |
||||
|
||||
|
||||
namespace eval argdoc { |
||||
lappend PUNKARGS [list { |
||||
@id -id ::punkboot::utils::parse_punkproject_version |
||||
@cmd -name "::punkboot::utils::parse_punkproject_version"\ |
||||
-summary\ |
||||
"Parse the [project] version from TOML content string"\ |
||||
-help\ |
||||
"Scans TOML content for the [project] section and returns |
||||
the value of the version key as a string. Returns an empty |
||||
string if the section or key is not found." |
||||
@leaders |
||||
content -type string -optional 0 -help\ |
||||
"TOML content string to parse" |
||||
}] |
||||
} |
||||
proc parse_punkproject_version {content} { |
||||
set in_project 0 |
||||
foreach line [split $content \n] { |
||||
set trimmed [string trim $line] |
||||
if {[string index $trimmed 0] eq {[} && [string index $trimmed end] eq {]}} { |
||||
set in_project [expr {$trimmed eq "\[project\]"}] |
||||
continue |
||||
} |
||||
if {$in_project && [regexp {^version\s*=\s*"([^"]+)"} $trimmed _ v]} { |
||||
return $v |
||||
} |
||||
} |
||||
return "" |
||||
} |
||||
|
||||
|
||||
namespace eval argdoc { |
||||
lappend PUNKARGS [list { |
||||
@id -id ::punkboot::utils::read_punkproject_version |
||||
@cmd -name "::punkboot::utils::read_punkproject_version"\ |
||||
-summary\ |
||||
"Read the [project] version from a TOML file"\ |
||||
-help\ |
||||
"Reads the file at tomlfile and returns the [project] |
||||
version value as a string. Returns an empty string if the |
||||
file does not exist or the version is not found." |
||||
@leaders |
||||
tomlfile -type string -optional 0 -help\ |
||||
"Path to the TOML file to read" |
||||
}] |
||||
} |
||||
proc read_punkproject_version {tomlfile} { |
||||
if {![file exists $tomlfile]} {return ""} |
||||
set fh [open $tomlfile r] |
||||
try { |
||||
set content [read $fh] |
||||
} finally { |
||||
close $fh |
||||
} |
||||
return [::punkboot::utils::parse_punkproject_version $content] |
||||
} |
||||
|
||||
|
||||
namespace eval argdoc { |
||||
lappend PUNKARGS [list { |
||||
@id -id ::punkboot::utils::read_changelog_latest_version |
||||
@cmd -name "::punkboot::utils::read_changelog_latest_version"\ |
||||
-summary\ |
||||
"Read the latest ## [X.Y.Z] version header from a changelog file"\ |
||||
-help\ |
||||
"Scans the changelog file from the top and returns the |
||||
version string from the first '## [X.Y.Z]' header line. |
||||
Returns an empty string if the file does not exist or no |
||||
matching header is found." |
||||
@leaders |
||||
changelogfile -type string -optional 0 -help\ |
||||
"Path to the changelog file to read" |
||||
}] |
||||
} |
||||
proc read_changelog_latest_version {changelogfile} { |
||||
if {![file exists $changelogfile]} {return ""} |
||||
set fh [open $changelogfile r] |
||||
try { |
||||
set content [read $fh] |
||||
} finally { |
||||
close $fh |
||||
} |
||||
foreach line [split $content \n] { |
||||
if {[regexp {^##\s*\[([0-9][^\]]*)\]} $line _ v]} { |
||||
return $v |
||||
} |
||||
} |
||||
return "" |
||||
} |
||||
|
||||
|
||||
namespace eval argdoc { |
||||
lappend PUNKARGS [list { |
||||
@id -id ::punkboot::utils::vcs_dirty_warnings |
||||
@cmd -name "::punkboot::utils::vcs_dirty_warnings"\ |
||||
-summary\ |
||||
"Warning lines for uncommitted VCS changes above a path"\ |
||||
-help\ |
||||
"Walks up from path to the nearest fossil and/or git root and |
||||
returns warning lines describing uncommitted changes. |
||||
Artifacts built from a dirty source tree have no committed |
||||
provenance - callers such as make.tcl vendorupdate use this |
||||
to flag source projects that should be committed first. |
||||
|
||||
checkedrootsvar names a dict variable in the caller's scope |
||||
used to report each VCS root at most once across calls. |
||||
label, if supplied, is prefixed into each warning to name |
||||
the calling operation (e.g. 'vendorupdate'). |
||||
|
||||
Returns an empty list if the path is clean, unversioned, |
||||
missing, already reported, or state cannot be determined." |
||||
@leaders |
||||
path -type string -optional 0 -help\ |
||||
"Path to check; the nearest enclosing fossil/git root is examined" |
||||
checkedrootsvar -type string -optional 0 -help\ |
||||
"Name of a dict variable in the caller's scope for dedupe across calls" |
||||
label -type string -optional 1 -default "" -help\ |
||||
"Operation name prefixed into warnings" |
||||
}] |
||||
} |
||||
proc vcs_dirty_warnings {path checkedrootsvar {label ""}} { |
||||
upvar 1 $checkedrootsvar checkedroots |
||||
if {![info exists checkedroots]} {set checkedroots [dict create]} |
||||
if {$label ne ""} {set label "$label "} |
||||
set warnings [list] |
||||
set dir [file normalize $path] |
||||
if {![file isdirectory $dir]} { |
||||
return $warnings ;#missing path - not this proc's business to report |
||||
} |
||||
set fossilroot "" |
||||
set gitroot "" |
||||
while {1} { |
||||
if {$fossilroot eq "" && ([file exists [file join $dir .fslckout]] || [file exists [file join $dir _FOSSIL_]])} { |
||||
set fossilroot $dir |
||||
} |
||||
if {$gitroot eq "" && [file exists [file join $dir .git]]} { |
||||
set gitroot $dir |
||||
} |
||||
if {$fossilroot ne "" || $gitroot ne ""} { |
||||
break ;#report at the nearest VCS root(s); a dual git+fossil root is caught in one pass |
||||
} |
||||
set parent [file dirname $dir] |
||||
if {$parent eq $dir} { break } |
||||
set dir $parent |
||||
} |
||||
if {$fossilroot ne "" && ![dict exists $checkedroots fossil,$fossilroot] && [llength [auto_execok fossil]]} { |
||||
dict set checkedroots fossil,$fossilroot 1 |
||||
#fossil changes must run from within the checkout |
||||
set original_cwd [pwd] |
||||
if {[catch { |
||||
cd $fossilroot |
||||
set fchanges [string trim [exec {*}[auto_execok fossil] changes]] |
||||
} errM]} { |
||||
lappend warnings "WARNING: ${label}could not determine fossil state of source project at $fossilroot ($errM)" |
||||
} elseif {$fchanges ne ""} { |
||||
lappend warnings "WARNING: ${label}source project at $fossilroot has uncommitted fossil changes ([llength [split $fchanges \n]] file(s)) - artifacts built from a dirty tree have no committed provenance" |
||||
} |
||||
cd $original_cwd |
||||
} |
||||
if {$gitroot ne "" && ![dict exists $checkedroots git,$gitroot] && [llength [auto_execok git]]} { |
||||
dict set checkedroots git,$gitroot 1 |
||||
if {[catch { |
||||
set gchanges [string trim [exec {*}[auto_execok git] -C $gitroot status --porcelain]] |
||||
} errM]} { |
||||
lappend warnings "WARNING: ${label}could not determine git state of source project at $gitroot ($errM)" |
||||
} elseif {$gchanges ne ""} { |
||||
lappend warnings "WARNING: ${label}source project at $gitroot has uncommitted git changes ([llength [split $gchanges \n]] file(s)) - artifacts built from a dirty tree have no committed provenance" |
||||
} |
||||
} |
||||
return $warnings |
||||
} |
||||
} |
||||
|
||||
namespace eval ::punk::args::register { |
||||
#use fully qualified so 8.6 doesn't find existing var in global namespace |
||||
lappend ::punk::args::register::NAMESPACES ::punkboot::utils ::punkboot::utils::argdoc |
||||
} |
||||
|
||||
## Ready |
||||
package provide punkboot::utils [tcl::namespace::eval punkboot::utils { |
||||
variable version |
||||
#- this version number, exactly 0.1.1, is a literal used in src module folders |
||||
#- we refer to this sometimes as the magic version number |
||||
set version 0.1.1 |
||||
}] |
||||
return |
||||
Loading…
Reference in new issue