jn
/
punkshell
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

G-093: regenerated build outputs (bootsupport + vfscommon punk::path 0.4.0) 

make.tcl modules + bootsupport + vfscommonupdate after the punk::path ***
source changes: path-0.3.0.tm -> path-0.4.0.tm snapshots in
src/bootsupport/modules and src/vfs/_vfscommon.vfs. The runtests parent
resolves punk::path from bootsupport - the refreshed snapshot is what enables
*** targeting at the runner discovery layer (discovery.tcl requires 0.4.0-).

Known ride-along not included: the bootsupport templates-0.2.0.tm modpod copy
failed to refresh ('invalid argument' - destination held open, likely a
running shell's zipfs mount; the stale copy predates this session) - reported
separately.

Claude-Session: https://claude.ai/code/session_01BNUVVkYq9vHa6G3S9a3XTZ
Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.com
master
Julian Noble 2 weeks ago
parent
bc958300b1
commit
89fb88fcf2
2 changed files with 294 additions and 108 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 189
      src/bootsupport/modules/punk/path-0.4.0.tm
  2. 189
      src/vfs/_vfscommon.vfs/modules/punk/path-0.4.0.tm

189
src/bootsupport/modules/punk/path-0.3.0.tm → src/bootsupport/modules/punk/path-0.4.0.tm
Unescape View File

@ -7,7 +7,7 @@
# (C) 2023 # (C) 2023
# #
# @@ Meta Begin # @@ Meta Begin
# Application punk::path 0.3.0 # Application punk::path 0.4.0
# Meta platform tcl # Meta platform tcl
# Meta license <unspecified> # Meta license <unspecified>
# @@ Meta End # @@ Meta End
@ -17,7 +17,7 @@
# doctools header # doctools header
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools #*** !doctools
#[manpage_begin punkshell_module_punk::path 0 0.3.0] #[manpage_begin punkshell_module_punk::path 0 0.4.0]
#[copyright "2023"] #[copyright "2023"]
#[titledesc {Filesystem path utilities}] [comment {-- Name section and table of contents description --}] #[titledesc {Filesystem path utilities}] [comment {-- Name section and table of contents description --}]
#[moddesc {punk path filesystem utils}] [comment {-- Description at end of page heading --}] #[moddesc {punk path filesystem utils}] [comment {-- Description at end of page heading --}]
@ -725,9 +725,10 @@ namespace eval punk::path {
proc pathglob_as_re {pathglob} { proc pathglob_as_re {pathglob} {
#*** !doctools #*** !doctools
#[call [fun pathglob_as_re] [arg pathglob]] #[call [fun pathglob_as_re] [arg pathglob]]
#[para] Returns a regular expression for matching a path to a glob pattern which can contain glob chars *|? in any segment of the path structure #[para] Returns a regular expression for matching a path to a glob pattern which can contain glob chars *|**|***|? in any segment of the path structure
#[para] Does not support square bracket globs or character classes. #[para] Does not support square bracket globs or character classes.
#[para] ** matches any number of subdirectories. #[para] ** as a whole segment matches one or more segments.
#[para] *** as a whole segment matches zero or more segments - e.g /etc/*** will match /etc itself as well as anything below it. (added 2026-07-20, G-093)
#[para] e.g /etc/**/*.txt will match any .txt files at any depth below /etc (except directly within /etc itself) #[para] e.g /etc/**/*.txt will match any .txt files at any depth below /etc (except directly within /etc itself)
#[para] e.g /etc/**.txt will match any .txt files at any depth below /etc #[para] e.g /etc/**.txt will match any .txt files at any depth below /etc
#[para] any segment that does not contain ** must match exactly one segment in the path #[para] any segment that does not contain ** must match exactly one segment in the path
@ -738,6 +739,7 @@ namespace eval punk::path {
#todo - consider whether a way to escape the glob chars ? * is practical - to allow literals ? * #todo - consider whether a way to escape the glob chars ? * is practical - to allow literals ? *
# - would require counting immediately-preceding backslashes # - would require counting immediately-preceding backslashes
set zom "\x00zom\x00" ;#zero-or-more-segments marker for whole-segment *** (segment regexes never contain \x00)
set pats [list] set pats [list]
foreach seg [file split $pathglob] { foreach seg [file split $pathglob] {
if {[string range $seg end end] eq "/"} { if {[string range $seg end end] eq "/"} {
@ -746,6 +748,12 @@ namespace eval punk::path {
switch -- $seg { switch -- $seg {
* {lappend pats {[^/]*}} * {lappend pats {[^/]*}}
** {lappend pats {.*}} ** {lappend pats {.*}}
*** {
#zero or more whole segments - adjacent *** duplicates collapse to one
if {[lindex $pats end] ne $zom} {
lappend pats $zom
}
}
default { default {
set seg [string map [list ^ {\^} $ {\$} \[ {\[} \] {\]} ( {\(} ) {\)} \{ \\\{ \\ {\\}] $seg] ;#treat regex characters (or tcl glob square bracket chars) in the input as literals set seg [string map [list ^ {\^} $ {\$} \[ {\[} \] {\]} ( {\(} ) {\)} \{ \\\{ \\ {\\}] $seg] ;#treat regex characters (or tcl glob square bracket chars) in the input as literals
#set seg [string map [list . {[.]}] $seg] #set seg [string map [list . {[.]}] $seg]
@ -759,7 +767,34 @@ namespace eval punk::path {
} }
} }
} }
return "^[join $pats /]\$" #join with / - except around zero-or-more markers, which must absorb one adjacent
#separator (a plain join cannot express 'zero segments'):
# X/*** -> ^X(?:/.*)?$ (trailing marker absorbs the preceding separator)
# ***/X a/***/b -> (?:.*/)?X ... (marker carries its trailing separator inside the
# optional group; no separator follows the marker)
# *** -> ^.*$
set n [llength $pats]
set out ""
for {set i 0} {$i < $n} {incr i} {
set pat [lindex $pats $i]
set is_zom [expr {$pat eq $zom}]
set is_last [expr {$i == $n - 1}]
if {$i > 0 && [lindex $pats $i-1] ne $zom && !($is_zom && $is_last)} {
append out /
}
if {$is_zom} {
if {$n == 1} {
append out {.*}
} elseif {$is_last} {
append out {(?:/.*)?}
} else {
append out {(?:.*/)?}
}
} else {
append out $pat
}
}
return "^${out}\$"
} }
punk::args::define { punk::args::define {
@ -775,10 +810,12 @@ namespace eval punk::path {
with 1 or more segments in between (so it will not match /usr/bin). with 1 or more segments in between (so it will not match /usr/bin).
A pattern such as /usr/** will match any path that has /usr as the first segment, with 1 or more segments A pattern such as /usr/** will match any path that has /usr as the first segment, with 1 or more segments
following (so it will not match /usr itself). following (so it will not match /usr itself).
A pattern such as /usr/*** will match /usr itself as well as any path below /usr
- *** as a whole segment matches zero or more segments (added 2026-07-20, G-093).
A pattern such as **/*.txt will match any path that ends with .txt, with 1 or more leading segments A pattern such as **/*.txt will match any path that ends with .txt, with 1 or more leading segments
(so it will not match test.txt or .txt). (so it will not match test.txt or .txt). Use ***/*.txt to also match a bare test.txt.
A pattern such as ** will match any path. A pattern such as ** will match any path.
The glob characters * and ? are the only special characters in the pathglob syntax. The glob characters * and ? (and the whole-segment forms ** and ***) are the only special characters in the pathglob syntax.
- they are treated as glob characters regardless of where they appear in the pathglob string. - they are treated as glob characters regardless of where they appear in the pathglob string.
Note that this is different from other Tcl glob contexts where square brackets can be used. Note that this is different from other Tcl glob contexts where square brackets can be used.
The pathglob syntax treats other characters, including square brackets as literals. The pathglob syntax treats other characters, including square brackets as literals.
@ -849,12 +886,12 @@ namespace eval punk::path {
set ismatch [regexp $re $path] ;#explicit -nocase 0 - require exact match of path literals including driveletter set ismatch [regexp $re $path] ;#explicit -nocase 0 - require exact match of path literals including driveletter
} else { } else {
#caller is using default for -nocase - which indicates case sensitivity - but we have an exception for the driveletter. #caller is using default for -nocase - which indicates case sensitivity - but we have an exception for the driveletter.
set re_segments [file split $re] ;#Note that file split c:/etc gives {c:/ etc} but file split ^c:/etc gives {^c: etc} #Direct head rewrite of the anchored regex: if the pattern begins with a windows
set first_seg [lindex $re_segments 0] #drive segment (^c:...) make just the drive letter class-insensitive.
if {[regexp {^\^(.{1}):$} $first_seg _match driveletter]} { #(The previous file-split of the regex text broke on forms where a group is glued
#first part of re is like "^c:" i.e a drive letter # to the drive - e.g ^c:(?:/.*)?$ from c:/*** - and allowed non-alpha 'drives'.)
set chars [string tolower $driveletter][string toupper $driveletter] if {[regexp {^\^([A-Za-z]):(.*)$} $re _match driveletter rest]} {
set re [join [concat "^\[$chars\]:" [lrange $re_segments 1 end]] /] ;#rebuild re with case insensitive driveletter only - use join - not file join. file join will misinterpret leading re segment. set re "^\[[string tolower $driveletter][string toupper $driveletter]\]:$rest"
} }
#puts stderr "-->re: $re" #puts stderr "-->re: $re"
set ismatch [regexp $re $path] set ismatch [regexp $re $path]
@ -1142,7 +1179,10 @@ namespace eval punk::path {
set pattern_head [lindex $pattern_parts 0] set pattern_head [lindex $pattern_parts 0]
set path_head [lindex $path_parts 0] set path_head [lindex $path_parts 0]
if {$pattern_head eq "**"} { if {$pattern_head eq "**" || $pattern_head eq "***"} {
#both spanning forms admit consuming zero path segments here (viability only
#asks whether a match below remains possible - *** additionally full-matches
#with zero segments, which globmatchpath handles)
if {[_pattern_prefix_viable_parts [lrange $pattern_parts 1 end] $path_parts]} { if {[_pattern_prefix_viable_parts [lrange $pattern_parts 1 end] $path_parts]} {
return 1 return 1
} }
@ -1160,6 +1200,10 @@ namespace eval punk::path {
} }
proc pattern_boundary {pattern} { proc pattern_boundary {pattern} {
#the directory at which a trailing-** pattern's subtree begins (that directory
#itself does not full-match X/** - the boundary branch grants descent+allbelow
#without including its files). Trailing-*** patterns need no boundary: they
#full-match their base directory directly.
set parts [file split $pattern] set parts [file split $pattern]
if {[llength $parts] >= 2 && [lindex $parts end] eq "**"} { if {[llength $parts] >= 2 && [lindex $parts end] eq "**"} {
return [file join {*}[lrange $parts 0 end-1]] return [file join {*}[lrange $parts 0 end-1]]
@ -1167,6 +1211,37 @@ namespace eval punk::path {
return "" return ""
} }
proc pattern_tail_spans {pattern} {
#1 when the pattern's final segment is ** or *** - a directory matching such a
#pattern implies every deeper directory also matches it (basis for the include
#allbelow shortcut and the exclude subtree prune). An exact or single-segment-glob
#tail does not extend below its match, keeping the in-dir (X), one-below (X/*),
#one-or-more-below (X/**) and zero-or-more-below (X/***) forms separable.
set last [lindex [file split $pattern] end]
return [expr {$last eq "**" || $last eq "***"}]
}
proc exclude_state {exclude_paths path} {
#Directory-oriented exclusion classification (separability fix 2026-07-20, G-093 -
#previously ANY matching pattern pruned the whole subtree, so an exact exclude
#like **/_aside also killed everything below _aside, contradicting the argdoc's
#distinct **/_aside vs **/_aside/** forms and the punk::path::subfolders precedent):
# subtree - a matching pattern's final segment is **|*** : prune path and all below
# files - matched by non-spanning pattern(s) only: exclude the files directly in
# path, but keep walking below it
# none - not excluded
set state none
foreach xp $exclude_paths {
if {[::punk::path::globmatchpath $xp $path]} {
if {[pattern_tail_spans $xp]} {
return subtree
}
set state files
}
}
return $state
}
proc directory_state {glob_paths path inherited_allbelow} { proc directory_state {glob_paths path inherited_allbelow} {
if {$inherited_allbelow} { if {$inherited_allbelow} {
return [dict create include_files 1 recurse_below 1 next_allbelow 1] return [dict create include_files 1 recurse_below 1 next_allbelow 1]
@ -1180,9 +1255,18 @@ namespace eval punk::path {
if {[::punk::path::globmatchpath $gp $path]} { if {[::punk::path::globmatchpath $gp $path]} {
set include_files 1 set include_files 1
set recurse_below 1 set recurse_below 1
if {[pattern_tail_spans $gp]} {
#trailing **|*** - every deeper directory also matches this pattern
set next_allbelow 1 set next_allbelow 1
break break
} }
#exact or single-segment-glob tail: this match includes only the files
#directly here - later patterns may still grant descent/allbelow
#(previously any full match set next_allbelow and broke, dragging the
# whole subtree in for exact/X-star patterns - separability fix 2026-07-20,
# G-093; the zipfs walk already behaved separably)
continue
}
set boundary [pattern_boundary $gp] set boundary [pattern_boundary $gp]
if {$boundary ne "" && [::punk::path::globmatchpath $boundary $path]} { if {$boundary ne "" && [::punk::path::globmatchpath $boundary $path]} {
@ -1233,15 +1317,6 @@ namespace eval punk::path {
} }
} }
proc _path_matches_any {patterns path} {
foreach pattern $patterns {
if {[::punk::path::globmatchpath $pattern $path]} {
return 1
}
}
return 0
}
proc _tailbase_relative {tailbase path} { proc _tailbase_relative {tailbase path} {
if {$tailbase eq ""} { if {$tailbase eq ""} {
return $path return $path
@ -1297,10 +1372,10 @@ namespace eval punk::path {
set directory [pwd] set directory [pwd]
} }
#-include-paths patterns are taken as-is: a bare * is the one-below lattice form,
#not a legacy match-everything alias (special-case collapse removed 2026-07-20,
#G-093 - use ** or *** for match-everything)
set glob_paths [dict get $opts -include-paths] set glob_paths [dict get $opts -include-paths]
if {"*" in $glob_paths} {
set glob_paths {*}
}
set sortmode [dict get $opts -sort] set sortmode [dict get $opts -sort]
if {$sortmode eq "natural"} { if {$sortmode eq "natural"} {
@ -1341,13 +1416,14 @@ namespace eval punk::path {
return [walk_treefilenames_zipfs $state] return [walk_treefilenames_zipfs $state]
} }
set opt_dir_match [_tailbase_match_path $opt_tailbase $opt_dir] set opt_dir_match [_tailbase_match_path $opt_tailbase $opt_dir]
if {[_path_matches_any $opt_exclude_paths $opt_dir_match]} { set dir_exclude_state [exclude_state $opt_exclude_paths $opt_dir_match]
if {$dir_exclude_state eq "subtree"} {
return [list] return [list]
} }
set files [list] set files [list]
set dir_state [directory_state $opt_glob_paths $opt_dir_match $callallbelow] set dir_state [directory_state $opt_glob_paths $opt_dir_match $callallbelow]
if {[dict get $dir_state include_files]} { if {[dict get $dir_state include_files] && $dir_exclude_state eq "none"} {
if {[catch {glob -nocomplain -dir $opt_dir -type f -- {*}$tailglobs} matches]} { if {[catch {glob -nocomplain -dir $opt_dir -type f -- {*}$tailglobs} matches]} {
puts stderr "treefilenames error while listing files in dir $opt_dir\n $matches" puts stderr "treefilenames error while listing files in dir $opt_dir\n $matches"
set dirfiles [list] set dirfiles [list]
@ -1389,21 +1465,19 @@ namespace eval punk::path {
} }
set okdirs [list] set okdirs [list]
foreach dir $dirdirs { foreach dir $dirdirs {
if {![_path_matches_any $opt_exclude_paths [_tailbase_match_path $opt_tailbase $dir]]} { #only subtree exclusions prune descent here - a child matched by a
#non-spanning exclude still walks (its own entry pass drops its files)
if {[exclude_state $opt_exclude_paths [_tailbase_match_path $opt_tailbase $dir]] ne "subtree"} {
lappend okdirs $dir lappend okdirs $dir
} }
} }
if {$opt_glob_paths eq "*"} {
set matchdirs $okdirs
} else {
set matchdirs [list] set matchdirs [list]
foreach dir $okdirs { foreach dir $okdirs {
if {$callallbelow || [child_path_state $opt_glob_paths [_tailbase_match_path $opt_tailbase $dir] $callallbelow]} { if {$callallbelow || [child_path_state $opt_glob_paths [_tailbase_match_path $opt_tailbase $dir] $callallbelow]} {
lappend matchdirs $dir lappend matchdirs $dir
} }
} }
}
set finaldirs [_sort_paths $matchdirs $opt_sort] set finaldirs [_sort_paths $matchdirs $opt_sort]
set childallbelow [expr {$callallbelow || [dict get $dir_state next_allbelow]}] set childallbelow [expr {$callallbelow || [dict get $dir_state next_allbelow]}]
@ -1434,7 +1508,7 @@ namespace eval punk::path {
error "treefilenames_zipfs can only be used on paths beginning with [zipfs root] on this systems" error "treefilenames_zipfs can only be used on paths beginning with [zipfs root] on this systems"
} }
set dir [string trimright $opt_dir "/"] set dir [string trimright $opt_dir "/"]
if {[_path_matches_any $opt_exclude_paths [_tailbase_match_path $opt_tailbase $dir]]} { if {[exclude_state $opt_exclude_paths [_tailbase_match_path $opt_tailbase $dir]] eq "subtree"} {
return [list] return [list]
} }
set dirlen [string length $dir] set dirlen [string length $dir]
@ -1455,7 +1529,7 @@ namespace eval punk::path {
break break
} }
if {$superpath ni $dirlist} { if {$superpath ni $dirlist} {
if {[_path_matches_any $opt_exclude_paths [_tailbase_match_path $opt_tailbase $superpath]]} { if {[exclude_state $opt_exclude_paths [_tailbase_match_path $opt_tailbase $superpath]] eq "subtree"} {
lappend skipdirs $superpath lappend skipdirs $superpath
set skipdir 1 set skipdir 1
break break
@ -1481,10 +1555,15 @@ namespace eval punk::path {
} else { } else {
set match 1 set match 1
} }
if {$match && $opt_glob_paths ne "*"} { if {$match} {
set file_dir_match [_tailbase_match_path $opt_tailbase [file dirname $finalpart]] set file_dir_match [_tailbase_match_path $opt_tailbase [file dirname $finalpart]]
set file_dir_state [directory_state $opt_glob_paths $file_dir_match 0] set file_dir_state [directory_state $opt_glob_paths $file_dir_match 0]
set match [dict get $file_dir_state include_files] set match [dict get $file_dir_state include_files]
if {$match && [exclude_state $opt_exclude_paths $file_dir_match] ne "none"} {
#files-level exclusion of the immediate directory
#(subtree exclusions were pruned via the superpath loop)
set match 0
}
} }
if {$match} { if {$match} {
set skipfile 0 set skipfile 0
@ -1500,7 +1579,7 @@ namespace eval punk::path {
} }
} else { } else {
if {$finalpart ni $dirlist} { if {$finalpart ni $dirlist} {
if {[_path_matches_any $opt_exclude_paths [_tailbase_match_path $opt_tailbase $finalpart]]} { if {[exclude_state $opt_exclude_paths [_tailbase_match_path $opt_tailbase $finalpart]] eq "subtree"} {
lappend skipdirs $finalpart lappend skipdirs $finalpart
} else { } else {
lappend dirlist $finalpart lappend dirlist $finalpart
@ -1525,9 +1604,10 @@ namespace eval punk::path {
"List of filenames below path. "List of filenames below path.
The resulting list is unsorted. The resulting list is unsorted.
The path globbing syntax supports *, ** and ? as glob characters in any segment of the path, with the following semantics: The path globbing syntax supports *, **, *** and ? as glob characters in any segment of the path, with the following semantics:
* matches any single segment in the path * matches any single segment in the path
** matches 1 or more segments in the path (so /usr/**/bin will match /usr/x/bin and user/x/y/bin but not /usr/bin ) ** as a whole segment matches 1 or more segments in the path (so /usr/**/bin will match /usr/x/bin and user/x/y/bin but not /usr/bin )
*** as a whole segment matches 0 or more segments in the path (so /usr/*** will match /usr itself as well as anything below it)
? matches any single character in a single segment of the path (so /usr/te?t will match /usr/test and /usr/text but not /usr/texxt) ? matches any single character in a single segment of the path (so /usr/te?t will match /usr/test and /usr/text but not /usr/texxt)
" "
-directory -type directory -help\ -directory -type directory -help\
@ -1546,22 +1626,35 @@ namespace eval punk::path {
" "
-sort -type any -default natural -choices {none ascii dictionary natural} -sort -type any -default natural -choices {none ascii dictionary natural}
-exclude-paths -default {} -help\ -exclude-paths -default {} -help\
"list of path patterns to exclude "list of directory path patterns to exclude
may include * and ** path segments e.g may include *, ** and *** path segments e.g
/usr/** (exclude subfolders based at /usr but not /usr (exclude files directly within /usr; subfolders
are still walked)
/usr/* (exclude files in folders exactly one below /usr)
/usr/** (exclude the subtrees based at /usr but not
files within /usr itself) files within /usr itself)
/usr/*** (exclude files within /usr and all its subfolders)
**/_aside (exclude files where _aside is last segment) **/_aside (exclude files where _aside is last segment)
**/_aside/* (exclude folders one below an _aside folder) **/_aside/** (exclude everything below any _aside segment)
**/_aside/** (exclude files in all folders with _aside as a segment)" Patterns whose final segment is ** or *** prune the matched
subtree; other matches exclude only the files directly in the
matching folder. Exclusion wins over inclusion for the same file."
-exclude-files -default {} -exclude-files -default {}
-include-paths -default {**} -help\ -include-paths -default {**} -help\
"list of path patterns to include "list of directory path patterns to include
may include * and ** path segments e.g may include *, ** and *** path segments e.g
/usr (include files directly within /usr only)
/usr/* (include files in folders exactly one below /usr)
/usr/** (include files in subfolders based at /usr but not /usr/** (include files in subfolders based at /usr but not
files within /usr itself) files within /usr itself)
/usr/*** (include files within /usr and all its subfolders)
**/_aside (include files where _aside is last segment in the folder) **/_aside (include files where _aside is last segment in the folder)
**/_aside/* (include files in folders one below an _aside folder) **/_aside/* (include files in folders one below an _aside folder)
**/_aside/** (include all files in folders with _aside as a segment)" **/_aside/** (include all files in folders with _aside as a segment)
A directory matching a pattern contributes the files directly within
it; patterns whose final segment is ** or *** also include everything
below their match. The /usr, /usr/*, /usr/** and /usr/*** forms are
deliberately separable."
@values -min 0 -max -1 -optional 1 -type string @values -min 0 -max -1 -optional 1 -type string
tailglobs -default * -multiple 1 -help\ tailglobs -default * -multiple 1 -help\
"Patterns to match against filename portion (last segment) of each file path "Patterns to match against filename portion (last segment) of each file path
@ -1788,7 +1881,7 @@ namespace eval ::punk::args::register {
package provide punk::path [namespace eval punk::path { package provide punk::path [namespace eval punk::path {
variable pkg punk::path variable pkg punk::path
variable version variable version
set version 0.3.0 set version 0.4.0
}] }]
return return

189
src/vfs/_vfscommon.vfs/modules/punk/path-0.3.0.tm → src/vfs/_vfscommon.vfs/modules/punk/path-0.4.0.tm
Unescape View File

@ -7,7 +7,7 @@
# (C) 2023 # (C) 2023
# #
# @@ Meta Begin # @@ Meta Begin
# Application punk::path 0.3.0 # Application punk::path 0.4.0
# Meta platform tcl # Meta platform tcl
# Meta license <unspecified> # Meta license <unspecified>
# @@ Meta End # @@ Meta End
@ -17,7 +17,7 @@
# doctools header # doctools header
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools #*** !doctools
#[manpage_begin punkshell_module_punk::path 0 0.3.0] #[manpage_begin punkshell_module_punk::path 0 0.4.0]
#[copyright "2023"] #[copyright "2023"]
#[titledesc {Filesystem path utilities}] [comment {-- Name section and table of contents description --}] #[titledesc {Filesystem path utilities}] [comment {-- Name section and table of contents description --}]
#[moddesc {punk path filesystem utils}] [comment {-- Description at end of page heading --}] #[moddesc {punk path filesystem utils}] [comment {-- Description at end of page heading --}]
@ -725,9 +725,10 @@ namespace eval punk::path {
proc pathglob_as_re {pathglob} { proc pathglob_as_re {pathglob} {
#*** !doctools #*** !doctools
#[call [fun pathglob_as_re] [arg pathglob]] #[call [fun pathglob_as_re] [arg pathglob]]
#[para] Returns a regular expression for matching a path to a glob pattern which can contain glob chars *|? in any segment of the path structure #[para] Returns a regular expression for matching a path to a glob pattern which can contain glob chars *|**|***|? in any segment of the path structure
#[para] Does not support square bracket globs or character classes. #[para] Does not support square bracket globs or character classes.
#[para] ** matches any number of subdirectories. #[para] ** as a whole segment matches one or more segments.
#[para] *** as a whole segment matches zero or more segments - e.g /etc/*** will match /etc itself as well as anything below it. (added 2026-07-20, G-093)
#[para] e.g /etc/**/*.txt will match any .txt files at any depth below /etc (except directly within /etc itself) #[para] e.g /etc/**/*.txt will match any .txt files at any depth below /etc (except directly within /etc itself)
#[para] e.g /etc/**.txt will match any .txt files at any depth below /etc #[para] e.g /etc/**.txt will match any .txt files at any depth below /etc
#[para] any segment that does not contain ** must match exactly one segment in the path #[para] any segment that does not contain ** must match exactly one segment in the path
@ -738,6 +739,7 @@ namespace eval punk::path {
#todo - consider whether a way to escape the glob chars ? * is practical - to allow literals ? * #todo - consider whether a way to escape the glob chars ? * is practical - to allow literals ? *
# - would require counting immediately-preceding backslashes # - would require counting immediately-preceding backslashes
set zom "\x00zom\x00" ;#zero-or-more-segments marker for whole-segment *** (segment regexes never contain \x00)
set pats [list] set pats [list]
foreach seg [file split $pathglob] { foreach seg [file split $pathglob] {
if {[string range $seg end end] eq "/"} { if {[string range $seg end end] eq "/"} {
@ -746,6 +748,12 @@ namespace eval punk::path {
switch -- $seg { switch -- $seg {
* {lappend pats {[^/]*}} * {lappend pats {[^/]*}}
** {lappend pats {.*}} ** {lappend pats {.*}}
*** {
#zero or more whole segments - adjacent *** duplicates collapse to one
if {[lindex $pats end] ne $zom} {
lappend pats $zom
}
}
default { default {
set seg [string map [list ^ {\^} $ {\$} \[ {\[} \] {\]} ( {\(} ) {\)} \{ \\\{ \\ {\\}] $seg] ;#treat regex characters (or tcl glob square bracket chars) in the input as literals set seg [string map [list ^ {\^} $ {\$} \[ {\[} \] {\]} ( {\(} ) {\)} \{ \\\{ \\ {\\}] $seg] ;#treat regex characters (or tcl glob square bracket chars) in the input as literals
#set seg [string map [list . {[.]}] $seg] #set seg [string map [list . {[.]}] $seg]
@ -759,7 +767,34 @@ namespace eval punk::path {
} }
} }
} }
return "^[join $pats /]\$" #join with / - except around zero-or-more markers, which must absorb one adjacent
#separator (a plain join cannot express 'zero segments'):
# X/*** -> ^X(?:/.*)?$ (trailing marker absorbs the preceding separator)
# ***/X a/***/b -> (?:.*/)?X ... (marker carries its trailing separator inside the
# optional group; no separator follows the marker)
# *** -> ^.*$
set n [llength $pats]
set out ""
for {set i 0} {$i < $n} {incr i} {
set pat [lindex $pats $i]
set is_zom [expr {$pat eq $zom}]
set is_last [expr {$i == $n - 1}]
if {$i > 0 && [lindex $pats $i-1] ne $zom && !($is_zom && $is_last)} {
append out /
}
if {$is_zom} {
if {$n == 1} {
append out {.*}
} elseif {$is_last} {
append out {(?:/.*)?}
} else {
append out {(?:.*/)?}
}
} else {
append out $pat
}
}
return "^${out}\$"
} }
punk::args::define { punk::args::define {
@ -775,10 +810,12 @@ namespace eval punk::path {
with 1 or more segments in between (so it will not match /usr/bin). with 1 or more segments in between (so it will not match /usr/bin).
A pattern such as /usr/** will match any path that has /usr as the first segment, with 1 or more segments A pattern such as /usr/** will match any path that has /usr as the first segment, with 1 or more segments
following (so it will not match /usr itself). following (so it will not match /usr itself).
A pattern such as /usr/*** will match /usr itself as well as any path below /usr
- *** as a whole segment matches zero or more segments (added 2026-07-20, G-093).
A pattern such as **/*.txt will match any path that ends with .txt, with 1 or more leading segments A pattern such as **/*.txt will match any path that ends with .txt, with 1 or more leading segments
(so it will not match test.txt or .txt). (so it will not match test.txt or .txt). Use ***/*.txt to also match a bare test.txt.
A pattern such as ** will match any path. A pattern such as ** will match any path.
The glob characters * and ? are the only special characters in the pathglob syntax. The glob characters * and ? (and the whole-segment forms ** and ***) are the only special characters in the pathglob syntax.
- they are treated as glob characters regardless of where they appear in the pathglob string. - they are treated as glob characters regardless of where they appear in the pathglob string.
Note that this is different from other Tcl glob contexts where square brackets can be used. Note that this is different from other Tcl glob contexts where square brackets can be used.
The pathglob syntax treats other characters, including square brackets as literals. The pathglob syntax treats other characters, including square brackets as literals.
@ -849,12 +886,12 @@ namespace eval punk::path {
set ismatch [regexp $re $path] ;#explicit -nocase 0 - require exact match of path literals including driveletter set ismatch [regexp $re $path] ;#explicit -nocase 0 - require exact match of path literals including driveletter
} else { } else {
#caller is using default for -nocase - which indicates case sensitivity - but we have an exception for the driveletter. #caller is using default for -nocase - which indicates case sensitivity - but we have an exception for the driveletter.
set re_segments [file split $re] ;#Note that file split c:/etc gives {c:/ etc} but file split ^c:/etc gives {^c: etc} #Direct head rewrite of the anchored regex: if the pattern begins with a windows
set first_seg [lindex $re_segments 0] #drive segment (^c:...) make just the drive letter class-insensitive.
if {[regexp {^\^(.{1}):$} $first_seg _match driveletter]} { #(The previous file-split of the regex text broke on forms where a group is glued
#first part of re is like "^c:" i.e a drive letter # to the drive - e.g ^c:(?:/.*)?$ from c:/*** - and allowed non-alpha 'drives'.)
set chars [string tolower $driveletter][string toupper $driveletter] if {[regexp {^\^([A-Za-z]):(.*)$} $re _match driveletter rest]} {
set re [join [concat "^\[$chars\]:" [lrange $re_segments 1 end]] /] ;#rebuild re with case insensitive driveletter only - use join - not file join. file join will misinterpret leading re segment. set re "^\[[string tolower $driveletter][string toupper $driveletter]\]:$rest"
} }
#puts stderr "-->re: $re" #puts stderr "-->re: $re"
set ismatch [regexp $re $path] set ismatch [regexp $re $path]
@ -1142,7 +1179,10 @@ namespace eval punk::path {
set pattern_head [lindex $pattern_parts 0] set pattern_head [lindex $pattern_parts 0]
set path_head [lindex $path_parts 0] set path_head [lindex $path_parts 0]
if {$pattern_head eq "**"} { if {$pattern_head eq "**" || $pattern_head eq "***"} {
#both spanning forms admit consuming zero path segments here (viability only
#asks whether a match below remains possible - *** additionally full-matches
#with zero segments, which globmatchpath handles)
if {[_pattern_prefix_viable_parts [lrange $pattern_parts 1 end] $path_parts]} { if {[_pattern_prefix_viable_parts [lrange $pattern_parts 1 end] $path_parts]} {
return 1 return 1
} }
@ -1160,6 +1200,10 @@ namespace eval punk::path {
} }
proc pattern_boundary {pattern} { proc pattern_boundary {pattern} {
#the directory at which a trailing-** pattern's subtree begins (that directory
#itself does not full-match X/** - the boundary branch grants descent+allbelow
#without including its files). Trailing-*** patterns need no boundary: they
#full-match their base directory directly.
set parts [file split $pattern] set parts [file split $pattern]
if {[llength $parts] >= 2 && [lindex $parts end] eq "**"} { if {[llength $parts] >= 2 && [lindex $parts end] eq "**"} {
return [file join {*}[lrange $parts 0 end-1]] return [file join {*}[lrange $parts 0 end-1]]
@ -1167,6 +1211,37 @@ namespace eval punk::path {
return "" return ""
} }
proc pattern_tail_spans {pattern} {
#1 when the pattern's final segment is ** or *** - a directory matching such a
#pattern implies every deeper directory also matches it (basis for the include
#allbelow shortcut and the exclude subtree prune). An exact or single-segment-glob
#tail does not extend below its match, keeping the in-dir (X), one-below (X/*),
#one-or-more-below (X/**) and zero-or-more-below (X/***) forms separable.
set last [lindex [file split $pattern] end]
return [expr {$last eq "**" || $last eq "***"}]
}
proc exclude_state {exclude_paths path} {
#Directory-oriented exclusion classification (separability fix 2026-07-20, G-093 -
#previously ANY matching pattern pruned the whole subtree, so an exact exclude
#like **/_aside also killed everything below _aside, contradicting the argdoc's
#distinct **/_aside vs **/_aside/** forms and the punk::path::subfolders precedent):
# subtree - a matching pattern's final segment is **|*** : prune path and all below
# files - matched by non-spanning pattern(s) only: exclude the files directly in
# path, but keep walking below it
# none - not excluded
set state none
foreach xp $exclude_paths {
if {[::punk::path::globmatchpath $xp $path]} {
if {[pattern_tail_spans $xp]} {
return subtree
}
set state files
}
}
return $state
}
proc directory_state {glob_paths path inherited_allbelow} { proc directory_state {glob_paths path inherited_allbelow} {
if {$inherited_allbelow} { if {$inherited_allbelow} {
return [dict create include_files 1 recurse_below 1 next_allbelow 1] return [dict create include_files 1 recurse_below 1 next_allbelow 1]
@ -1180,9 +1255,18 @@ namespace eval punk::path {
if {[::punk::path::globmatchpath $gp $path]} { if {[::punk::path::globmatchpath $gp $path]} {
set include_files 1 set include_files 1
set recurse_below 1 set recurse_below 1
if {[pattern_tail_spans $gp]} {
#trailing **|*** - every deeper directory also matches this pattern
set next_allbelow 1 set next_allbelow 1
break break
} }
#exact or single-segment-glob tail: this match includes only the files
#directly here - later patterns may still grant descent/allbelow
#(previously any full match set next_allbelow and broke, dragging the
# whole subtree in for exact/X-star patterns - separability fix 2026-07-20,
# G-093; the zipfs walk already behaved separably)
continue
}
set boundary [pattern_boundary $gp] set boundary [pattern_boundary $gp]
if {$boundary ne "" && [::punk::path::globmatchpath $boundary $path]} { if {$boundary ne "" && [::punk::path::globmatchpath $boundary $path]} {
@ -1233,15 +1317,6 @@ namespace eval punk::path {
} }
} }
proc _path_matches_any {patterns path} {
foreach pattern $patterns {
if {[::punk::path::globmatchpath $pattern $path]} {
return 1
}
}
return 0
}
proc _tailbase_relative {tailbase path} { proc _tailbase_relative {tailbase path} {
if {$tailbase eq ""} { if {$tailbase eq ""} {
return $path return $path
@ -1297,10 +1372,10 @@ namespace eval punk::path {
set directory [pwd] set directory [pwd]
} }
#-include-paths patterns are taken as-is: a bare * is the one-below lattice form,
#not a legacy match-everything alias (special-case collapse removed 2026-07-20,
#G-093 - use ** or *** for match-everything)
set glob_paths [dict get $opts -include-paths] set glob_paths [dict get $opts -include-paths]
if {"*" in $glob_paths} {
set glob_paths {*}
}
set sortmode [dict get $opts -sort] set sortmode [dict get $opts -sort]
if {$sortmode eq "natural"} { if {$sortmode eq "natural"} {
@ -1341,13 +1416,14 @@ namespace eval punk::path {
return [walk_treefilenames_zipfs $state] return [walk_treefilenames_zipfs $state]
} }
set opt_dir_match [_tailbase_match_path $opt_tailbase $opt_dir] set opt_dir_match [_tailbase_match_path $opt_tailbase $opt_dir]
if {[_path_matches_any $opt_exclude_paths $opt_dir_match]} { set dir_exclude_state [exclude_state $opt_exclude_paths $opt_dir_match]
if {$dir_exclude_state eq "subtree"} {
return [list] return [list]
} }
set files [list] set files [list]
set dir_state [directory_state $opt_glob_paths $opt_dir_match $callallbelow] set dir_state [directory_state $opt_glob_paths $opt_dir_match $callallbelow]
if {[dict get $dir_state include_files]} { if {[dict get $dir_state include_files] && $dir_exclude_state eq "none"} {
if {[catch {glob -nocomplain -dir $opt_dir -type f -- {*}$tailglobs} matches]} { if {[catch {glob -nocomplain -dir $opt_dir -type f -- {*}$tailglobs} matches]} {
puts stderr "treefilenames error while listing files in dir $opt_dir\n $matches" puts stderr "treefilenames error while listing files in dir $opt_dir\n $matches"
set dirfiles [list] set dirfiles [list]
@ -1389,21 +1465,19 @@ namespace eval punk::path {
} }
set okdirs [list] set okdirs [list]
foreach dir $dirdirs { foreach dir $dirdirs {
if {![_path_matches_any $opt_exclude_paths [_tailbase_match_path $opt_tailbase $dir]]} { #only subtree exclusions prune descent here - a child matched by a
#non-spanning exclude still walks (its own entry pass drops its files)
if {[exclude_state $opt_exclude_paths [_tailbase_match_path $opt_tailbase $dir]] ne "subtree"} {
lappend okdirs $dir lappend okdirs $dir
} }
} }
if {$opt_glob_paths eq "*"} {
set matchdirs $okdirs
} else {
set matchdirs [list] set matchdirs [list]
foreach dir $okdirs { foreach dir $okdirs {
if {$callallbelow || [child_path_state $opt_glob_paths [_tailbase_match_path $opt_tailbase $dir] $callallbelow]} { if {$callallbelow || [child_path_state $opt_glob_paths [_tailbase_match_path $opt_tailbase $dir] $callallbelow]} {
lappend matchdirs $dir lappend matchdirs $dir
} }
} }
}
set finaldirs [_sort_paths $matchdirs $opt_sort] set finaldirs [_sort_paths $matchdirs $opt_sort]
set childallbelow [expr {$callallbelow || [dict get $dir_state next_allbelow]}] set childallbelow [expr {$callallbelow || [dict get $dir_state next_allbelow]}]
@ -1434,7 +1508,7 @@ namespace eval punk::path {
error "treefilenames_zipfs can only be used on paths beginning with [zipfs root] on this systems" error "treefilenames_zipfs can only be used on paths beginning with [zipfs root] on this systems"
} }
set dir [string trimright $opt_dir "/"] set dir [string trimright $opt_dir "/"]
if {[_path_matches_any $opt_exclude_paths [_tailbase_match_path $opt_tailbase $dir]]} { if {[exclude_state $opt_exclude_paths [_tailbase_match_path $opt_tailbase $dir]] eq "subtree"} {
return [list] return [list]
} }
set dirlen [string length $dir] set dirlen [string length $dir]
@ -1455,7 +1529,7 @@ namespace eval punk::path {
break break
} }
if {$superpath ni $dirlist} { if {$superpath ni $dirlist} {
if {[_path_matches_any $opt_exclude_paths [_tailbase_match_path $opt_tailbase $superpath]]} { if {[exclude_state $opt_exclude_paths [_tailbase_match_path $opt_tailbase $superpath]] eq "subtree"} {
lappend skipdirs $superpath lappend skipdirs $superpath
set skipdir 1 set skipdir 1
break break
@ -1481,10 +1555,15 @@ namespace eval punk::path {
} else { } else {
set match 1 set match 1
} }
if {$match && $opt_glob_paths ne "*"} { if {$match} {
set file_dir_match [_tailbase_match_path $opt_tailbase [file dirname $finalpart]] set file_dir_match [_tailbase_match_path $opt_tailbase [file dirname $finalpart]]
set file_dir_state [directory_state $opt_glob_paths $file_dir_match 0] set file_dir_state [directory_state $opt_glob_paths $file_dir_match 0]
set match [dict get $file_dir_state include_files] set match [dict get $file_dir_state include_files]
if {$match && [exclude_state $opt_exclude_paths $file_dir_match] ne "none"} {
#files-level exclusion of the immediate directory
#(subtree exclusions were pruned via the superpath loop)
set match 0
}
} }
if {$match} { if {$match} {
set skipfile 0 set skipfile 0
@ -1500,7 +1579,7 @@ namespace eval punk::path {
} }
} else { } else {
if {$finalpart ni $dirlist} { if {$finalpart ni $dirlist} {
if {[_path_matches_any $opt_exclude_paths [_tailbase_match_path $opt_tailbase $finalpart]]} { if {[exclude_state $opt_exclude_paths [_tailbase_match_path $opt_tailbase $finalpart]] eq "subtree"} {
lappend skipdirs $finalpart lappend skipdirs $finalpart
} else { } else {
lappend dirlist $finalpart lappend dirlist $finalpart
@ -1525,9 +1604,10 @@ namespace eval punk::path {
"List of filenames below path. "List of filenames below path.
The resulting list is unsorted. The resulting list is unsorted.
The path globbing syntax supports *, ** and ? as glob characters in any segment of the path, with the following semantics: The path globbing syntax supports *, **, *** and ? as glob characters in any segment of the path, with the following semantics:
* matches any single segment in the path * matches any single segment in the path
** matches 1 or more segments in the path (so /usr/**/bin will match /usr/x/bin and user/x/y/bin but not /usr/bin ) ** as a whole segment matches 1 or more segments in the path (so /usr/**/bin will match /usr/x/bin and user/x/y/bin but not /usr/bin )
*** as a whole segment matches 0 or more segments in the path (so /usr/*** will match /usr itself as well as anything below it)
? matches any single character in a single segment of the path (so /usr/te?t will match /usr/test and /usr/text but not /usr/texxt) ? matches any single character in a single segment of the path (so /usr/te?t will match /usr/test and /usr/text but not /usr/texxt)
" "
-directory -type directory -help\ -directory -type directory -help\
@ -1546,22 +1626,35 @@ namespace eval punk::path {
" "
-sort -type any -default natural -choices {none ascii dictionary natural} -sort -type any -default natural -choices {none ascii dictionary natural}
-exclude-paths -default {} -help\ -exclude-paths -default {} -help\
"list of path patterns to exclude "list of directory path patterns to exclude
may include * and ** path segments e.g may include *, ** and *** path segments e.g
/usr/** (exclude subfolders based at /usr but not /usr (exclude files directly within /usr; subfolders
are still walked)
/usr/* (exclude files in folders exactly one below /usr)
/usr/** (exclude the subtrees based at /usr but not
files within /usr itself) files within /usr itself)
/usr/*** (exclude files within /usr and all its subfolders)
**/_aside (exclude files where _aside is last segment) **/_aside (exclude files where _aside is last segment)
**/_aside/* (exclude folders one below an _aside folder) **/_aside/** (exclude everything below any _aside segment)
**/_aside/** (exclude files in all folders with _aside as a segment)" Patterns whose final segment is ** or *** prune the matched
subtree; other matches exclude only the files directly in the
matching folder. Exclusion wins over inclusion for the same file."
-exclude-files -default {} -exclude-files -default {}
-include-paths -default {**} -help\ -include-paths -default {**} -help\
"list of path patterns to include "list of directory path patterns to include
may include * and ** path segments e.g may include *, ** and *** path segments e.g
/usr (include files directly within /usr only)
/usr/* (include files in folders exactly one below /usr)
/usr/** (include files in subfolders based at /usr but not /usr/** (include files in subfolders based at /usr but not
files within /usr itself) files within /usr itself)
/usr/*** (include files within /usr and all its subfolders)
**/_aside (include files where _aside is last segment in the folder) **/_aside (include files where _aside is last segment in the folder)
**/_aside/* (include files in folders one below an _aside folder) **/_aside/* (include files in folders one below an _aside folder)
**/_aside/** (include all files in folders with _aside as a segment)" **/_aside/** (include all files in folders with _aside as a segment)
A directory matching a pattern contributes the files directly within
it; patterns whose final segment is ** or *** also include everything
below their match. The /usr, /usr/*, /usr/** and /usr/*** forms are
deliberately separable."
@values -min 0 -max -1 -optional 1 -type string @values -min 0 -max -1 -optional 1 -type string
tailglobs -default * -multiple 1 -help\ tailglobs -default * -multiple 1 -help\
"Patterns to match against filename portion (last segment) of each file path "Patterns to match against filename portion (last segment) of each file path
@ -1788,7 +1881,7 @@ namespace eval ::punk::args::register {
package provide punk::path [namespace eval punk::path { package provide punk::path [namespace eval punk::path {
variable pkg punk::path variable pkg punk::path
variable version variable version
set version 0.3.0 set version 0.4.0
}] }]
return return
Write Preview
Loading…
Cancel
Save