set command [uplevel 1 [list namespace which $command]]
if {$command eq ""} {
#review
puts stderr "commandstack::rename_command no rename performed for command '$command' by '$renamer'. command '$command' not found in calling context. Ensure command name is fully qualified or that command exists."
#add something to stack?
return [dict create implementation ""]
}
set mungedcommand [string map {:: _ns_} $command]
set mungedrenamer [string map {:: _ns_} $renamer]
variable all_stacks
@ -284,7 +290,8 @@ namespace eval commandstack {
]
if {![dict get $nextinfo do_rename]} {
#review
puts stderr "no rename performed"
puts stderr "commandstack::rename_command no rename performed for command '$command' by '$renamer'"
#don't cache negative result for any relative paths - as they may become valid if the file appears in the relative location, or if the user changes directory and the same relative path points to a different file.
#our only way to do this is by cooperating with the unknown handler.
set auto_execs($name) "for_unknown_handler by punk::auto_exec relative_path - file existence should be re-checked at call time"
return $auto_execs($name)
}
if {[string tolower [file extension $name]] eq ".lnk"} {
#special case .lnk
#todo - consider working directory or other properties of link before launching?
@ -246,11 +249,11 @@ namespace eval punk {
set associnfo [punk::auto_exec::shell_open_command $test_ext]
set valuetype [dict get $associnfo type]
set assoc [dict get $associnfo value]
set ftype [dict get $associnfo filetype]
set windows_file_type [dict get $associnfo filetype]
set run [punk::auto_exec::shell_command_as_tcl_list -type $valuetype $assoc $file] ;# -workingdir [pwd] vs path of script?
@ -269,6 +272,8 @@ namespace eval punk {
}
}
}
#cache negative result for absolute paths - as they will always point to the same location, so if they don't exist now, they won't exist later.
set auto_execs($name) ""
return ""
}
@ -559,7 +564,7 @@ if {![llength [info commands ::ansistring]]} {
package require punk::repl::codethread
package require punk::config
#package require textblock
package require punk::console ;#requires Thread
catch {package require punk::console} ;#requires Thread - will not work in safe interps.
package require punk::ns
package require punk::winpath ;# for windows paths - but has functions that can be called on unix systems
package require punk::repo
@ -5396,27 +5401,54 @@ namespace eval punk {
} else {
set repl_runid [punk::get_repl_runid]
#set ::punk::last_run_display [list]
if {$new eq "(resolve_in_unknown_handler) punk::auto_exec absolute_path required"} {
#re-resolve.
puts "(unknown-handler): auto_execok for $name requires absolute path. Re-resolving $name with absolute path."
set resolved $new
if {[string match "for_unknown_handler *" $new]} {
set ext [file extension $name]
set associnfo [punk::auto_exec::shell_open_command $ext]
set valuetype [dict get $associnfo type]
set assoc [dict get $associnfo value]
set ftype [dict get $associnfo filetype]
set fullpath [file normalize $name]
#at least for .url files - long paths (paths with multiple spaces?) can fail to run. Using the short path seems to fix this.
#This seems hacky but anyway..
set attributes [file attributes $fullpath]
if {[dict exists $attributes -shortname]} {
set fullpath [dict get $attributes -shortname]
if {[string tolower $ext] eq ".lnk"} {
#for .lnk files we can often resolve the target path without needing to execute the shell open command
#- which is desirable because it allows us to avoid the absolute path requirement for unknown-handler auto_execok commands,
#which is desirable because it allows us to support relative paths and paths with environment variables in them
#(e.g for .lnk files that point to executables with environment variables in the path)
set targetinfo [punk::winlnk::resolve $name]
if {[dict exists $targetinfo link_roottarget]} {
set resolved [dict get $targetinfo link_roottarget]
#arguments?
} else {
puts "(unknown-handler): failed to resolve .lnk target for $name. Falling back to shell open command resolution, which may fail if absolute path is required."
}
} else {
#re-resolve.
set associnfo [punk::auto_exec::shell_open_command $ext]
set registry_valuetype [dict get $associnfo type] ;#sz vs expand_sz
set command_spec [dict get $associnfo value]
set windows_file_type [dict get $associnfo filetype]
if {[string match "*absolute_path required" $new]} {
puts "(unknown-handler): auto_execok for $name requires absolute path. Re-resolving $name with absolute path."
set fullpath [file normalize $name]
#at least for .url files - long paths (paths with multiple spaces?) can fail to run. Using the short path seems to fix this.
#This seems hacky but anyway..
set attributes [file attributes $fullpath]
if {[dict exists $attributes -shortname]} {
set fullpath [dict get $attributes -shortname]
}
set resolved [punk::auto_exec::shell_command_as_tcl_list -type $registry_valuetype $command_spec $fullpath]
} else {
#todo
set newnorm [file normalize $name]
puts stderr "(unknown-handler): re-resolving $name with auto_execok $newnorm"
set resolved [auto_execok $newnorm]
}
}
set new [punk::auto_exec::shell_command_as_tcl_list -type $valuetype $assoc $fullpath]
}
if {$resolved eq ""} {
#resolved may be emptyif auto_execok returns an empty string.
dict set ::tcl::UnknownOptions -code error
set ::tcl::UnknownResult "unresolved path '$name'"
#These aliases work fine for interactive use - but the result is always a string int-rep
#interp alias {} ~ {} file join $::env(HOME) ;#HOME must be capitalized to work cross platform (lowercase home works on windows - but probably not elsewhere)
if {$current_chunk ne "" || $current_chunk eq "" && [lindex $quoted end]} {
#we add the current chunk to the result list if it's not empty, or if it is empty but is quoted (because in that case we want to preserve it as an empty argument).
#we add the current chunk to the result list if it's not empty, or if it is empty but is quoted (because in that case we want to preserve it as an empty argument).
set files [glob -nocomplain -dir $folderpath -types f * .*]
}
set globs [list *]
} else {
if {![llength $types_entry] || "d" in $types_entry} {
#we need to check directories for hidden attribute - as on windows, not all dotfiles are hidden, and not all hidden files are dotfiles
set hdirs [glob -nocomplain -dir $folderpath -types {hidden d} $opt_glob]
set dirs [glob -nocomplain -dir $folderpath -types d $opt_glob]
}
if {![llength $types_entry] || "l" in $types_entry} {
set hlinks [glob -nocomplain -dir $folderpath -types {hidden l} $opt_glob]
set links [glob -nocomplain -dir $folderpath -types l $opt_glob] ;#links may have dupes - we don't care. punk::lib::struct_set_diff_unique
}
if {![llength $types_entry] || "f" in $types_entry} {
set hfiles [glob -nocomplain -dir $folderpath -types {hidden f} $opt_glob]
set files [glob -nocomplain -dir $folderpath -types f $opt_glob]
}
set globs [list $opt_glob]
}
#on windows this is a lot of separate globs to perform. Using the du_dirlisting_twapi is preferred for performance on windows - but this is a fallback and for testing.
#if {![llength $types_entry] || "d" in $types_entry} {}
if {!$skip_dirs} {
#we need to check directories for hidden attribute - as on windows, not all dotfiles are hidden, and not all hidden files are dotfiles
set hdirs [glob -nocomplain -dir $folderpath -types {hidden d} {*}$globs]
set dirs [glob -nocomplain -dir $folderpath -types d {*}$globs]
}
if {!$skip_links} {
set hlinks [glob -nocomplain -dir $folderpath -types {hidden l} {*}$globs]
set links [glob -nocomplain -dir $folderpath -types l {*}$globs] ;#links may have dupes - we don't care. punk::lib::struct_set_diff_unique
}
if {!$skip_files} {
set hfiles [glob -nocomplain -dir $folderpath -types {hidden f} {*}$globs]
set files [glob -nocomplain -dir $folderpath -types f {*}$globs]
}
} else {
if {$opt_glob eq "*"} {
#Note - glob operations seem to be faster than looped tests like 'file isdirectory' & 'file readlink'
#set parent [lindex $folders $folderidx]
#set dirs [glob -nocomplain -dir $folderpath -types d * .*]
#set links [glob -nocomplain -dir $folderpath -types l * .*] ;#links may have dupes - we don't care. punk::lib::struct_set_diff_unique
#set files [glob -nocomplain -dir $folderpath -types f * .*]
set globs [list * .*]
} else {
set globs [list $opt_glob]
#set dirs [glob -nocomplain -dir $folderpath -types d $opt_glob]
#set links [glob -nocomplain -dir $folderpath -types l $opt_glob] ;#links may have dupes - we don't care. punk::lib::struct_set_diff_unique
#set files [glob -nocomplain -dir $folderpath -types f $opt_glob]
}
if {![llength $types_entry] || "d" in $types_entry} {
#we need to classify our results - unlike a standard glob * operation which returns all entries in one collection.
#Note - glob operations seem to be faster than looped tests like 'file isdirectory' & 'file readlink'
#however - these are still significantly slower than a single glob with no restrictions - so we want to minimize the number of globs we do
#- but we also want to avoid doing extra work classifying entries that we will end up ignoring based on types/attributes/permissions filters.
if {!$skip_dirs} {
set dirs [glob -nocomplain -dir $folderpath -types d {*}$globs]
}
if {![llength $types_entry] || "l" in $types_entry} {
if {!$skip_links} {
set links [glob -nocomplain -dir $folderpath -types l {*}$globs] ;#links may have dupes - we don't care. punk::lib::struct_set_diff_unique
}
if {![llength $types_entry] || "f" in $types_entry} {
if {!$skip_files} {
set files [glob -nocomplain -dir $folderpath -types f {*}$globs]
}
@ -1957,6 +1974,7 @@ namespace eval punk::du {
set types_entry [list]
set types_attribute [list]
set types_permission [list]
set types_REQUIRED [list]
foreach t $entry_and_attribute_types {
switch -- $t {
f - d - l - p - s - b - c {
@ -2155,7 +2173,7 @@ namespace eval punk::du {
set errors [dict create]
if {"windows" eq $::tcl_platform(platform)} {
if {$opt_glob eq "*"} {
set globs [list * .*]
set globs [list *]
} else {
set globs [list $opt_glob]
}
@ -2295,6 +2313,13 @@ namespace eval punk::du {
#we don't classify anything as 'flaggedhidden' on unix.
#it is a convention for dotfiles rather than a flag - and we'll leave the distinction for the display library
set dirs {}
set hdirs {}
set files {}
set hfiles {}
set links {}
set hlinks {}
if {$opt_glob eq "*"} {
set globs [list * .*]
} else {
@ -2341,6 +2366,7 @@ namespace eval punk::du {
if {"$ft" in $meta_types} {
foreach path [set $lvar] {
if {$has_winpath && [punk::winpath::illegalname_test $path]} {
#review. we don't want to fix the path - we just want classify it as nonportable
set testpath [punk::winpath::illegalname_fix $path]
if {![catch {file stat $testpath arrstat} errM]} {
dict set meta_dict $path [dict create shorttype $ft {*}[array get arrstat]]
@ -2350,7 +2376,7 @@ namespace eval punk::du {
dict set meta_dict $path [dict create shorttype $ft {*}$empty_stat_dict]
}
} else {
#caller may have read perm on the containing folder - but not on child item - so file stat could raise an error
#caller may have permission to read on the containing folder - but not on child item - so file stat could raise an error
if {![catch {file stat $path arrstat} errM]} {
dict set meta_dict $path [dict create shorttype $ft {*}[array get arrstat]]
#It can be slightly expensive (for example involving network calls on windows domains)
variable user_home_cache
set user_home_cache ""
#tilde
#These aliases work fine for interactive use - but the result is always a string internal-rep
#interp alias {} ~ {} file join $::env(HOME) ;#HOME must be capitalized to work cross platform (lowercase home works on windows - but probably not elsewhere)
"Return user's home directory as the process sees it"\
-help\
"Return the user's home directory path as the process sees it.
(This is not always the same as ::env(HOME))
With additional arguments, return the path obtained by joining
the user's home directory with the supplied arguments.
usage e.g
cd [~]
(change to user's home)
.// [~] .config
(change to .config directory within the user's home
and list contents.)
equivalently:
gohome .config
(gohome uses the output of ~ to determine the home directory)
If the home directory cannot be determined due to the environment
in which the process is running, an error will be raised, as returning
an empty string is not a useful result and can cause issues if used as a path.
"
@opts
@values -min 0 -max -1
arg -type any -optional 1 -multiple 1
}
}
proc ~ {args} {
#review - HOME may be undefined or have been set to another value by other tools or the parent process.
#The process may even be running in a context where there is no home directory - e.g a container with no users, or a system service context.
#(we may be in a safe interp - which generally won't have env vars or filesystem access)
variable user_home_cache
if {$user_home_cache ne ""} {
set hdir $user_home_cache
#we still need to process args to join them to the home directory - but we can skip all the work of determining the home directory again.
} else {
set hdir ""
if {[catch {auto_execok whoami} whoami_exe]} {
set whoami_exe ""
}
if {$whoami_exe eq ""} {
#try env USER or USERNAME - these are commonly set to the username on many platforms - but may not be set in all contexts.
if {[info exists ::env(USER)]} {
set user $::env(USER)
} elseif {[info exists ::env(USERNAME)]} {
set user $::env(USERNAME)
} else {
set user ""
}
} else {
#set user [exec {*}$whoami_exe]
if {[catch {exec {*}$whoami_exe} user]} {
set user ""
}
}
if {[string trim $user] ne ""} {
#normalize user for use with 'file tildeexpand ~<user>'
#on windows, whoami may return DOMAIN\USER
#for tildeexpand to work, we need to convert this to USER@DOMAIN
if {"windows" eq $::tcl_platform(platform)} {
set parts [split $user "\\"]
#we expect only 1 or 2 parts
if {[llength $parts] == 2} {
lassign $parts domain username
#if we use username@domain format - we get the domain controller's view of our home directory - which can be different from the local machine's view of our home directory.
#e.g file tildeexpand ~jnoble@corp can return a local non existant path like c:/users/jnoble
#but it may be c:/users/jnoble.corp - or c:/users/something_else_entirely depending on how the local machine is configured.
#It may be that the domain controller is correct if it returns a network path like \\server\users\jnoble ??
#Network paths are not necessarily the preferred practive as of 2026 - but may still exist.
#Microsoft is encouraging the use of cloud systems - but it it unknown at this stage what sort of paths can be returned.
#REVIEW
set domainuser "$username@$domain"
#we can run file tildeexpand with username@domain and test if the path is writable
#this reduces the possibility that there happens to be a local user with the same name as the domain user - which would cause us to get the wrong home directory.
if {![catch {file tildeexpand ~$domainuser} path]} {
if {[file writable $path]} {
set user $domainuser
set hdir $path ;#set hdir so we don't re-lookup below.
}
}
if {$hdir eq ""} {
#for now we will use the unqualified username.
set user $username
}
} elseif {[llength $parts] == 1} {
set user [lindex $parts 0]
} else {
#unexpected format - emit warning
puts stderr "Warning: Unexpected format of username '$user' returned by whoami. Expected format 'DOMAIN\\USER' or 'USER'. Unable to determine home directory for this user."
set user ""
}
}
#only enter this branch if hdir wasn't resolved above for windows domain user.
if {$hdir eq "" && $user ne ""} {
#we use file tildeexpand ~user because the intention is stated in the tcl source as:
#* the intent is to retrieve (as on Unix) the system's view
#* of the home irrespective of environment settings of HOME
#* and USERPROFILE.
# - this aligns with our intention here.
if {![catch {file tildeexpand ~$user} path]} {
set hdir [punk::valcopy $path]
} else {
#tcl <= 8.6 may not have file tildeexpand.
#we now have no option but to rely on environment variables - which may not be set or may be set to an incorrect value
#as tcl <= 8.6 needs to be supported - but isn't the primary target we will allow this fallback - but raise a warning as this is not ideal.
puts stderr "punk::nav::fs::~ Warning: Unable to determine home directory for user '$user' using 'file tildeexpand ~$user'. Falling back to environment variables, which may not be set or may be incorrect. Consider upgrading to Tcl 9.0 or later for improved reliability."
if {"windows" eq $::tcl_platform(platform)} {
if {[info exists ::env(USERPROFILE)]} {
set hdir [punk::valcopy $::env(USERPROFILE)]
} else {
set hdir ""
}
} else {
if {[info exists ::env(HOME)]} {
set hdir [punk::valcopy $::env(HOME)]
} else {
set hdir ""
}
}
}
}
}
}
if {$hdir eq ""} {
error "punk::nav::fs::~ Unable to determine home directory for user '$user'. Consider upgrading to Tcl 9.0 or later for improved reliability in home directory detection."
}
file pathtype $hdir ;#flips internal-rep to path
if {![file isdirectory $hdir]} {
#file isdirectory should also return true if the path exists and is a symlink to a directory - but if it doesn't exist at all - or is a file - then we have a problem.
error "punk::nav::fs::~ Determined home directory path '$hdir' does not exist (or is not a directory)."
} else {
if {![file readable $hdir]} {
error "punk::nav::fs::~ Determined home directory path '$hdir' is not readable."
}
}
set user_home_cache $hdir ;#cache only the home directory.
set d $hdir
#use the file join 2-arg optimisation to avoid losing path-rep - probably doesn't give any advantage on all Tcl versions
#review - for what versions does/did the 2-arg version of file join not just return a string?
error "punk::nav::fs::d/new $error_string\n$num_created directories out of [llength $fullpath_list] were created successfully before the error was encountered."
error "punk::nav::fs::newdir $error_string\n$num_created directories out of [llength $fullpath_list] were created successfully before the error was encountered."
}
#display summaries of created directories (which may have already existed) by reusing d/ to get info on them.
set query_paths [lmap v $paths {string cat $v "/*"}]
#no link_target - probably an ordinary file - but there could have been some other error in reading the binary windows lnk format.
#no link_roottarget - probably an ordinary file - but there could have been some other error in reading the binary windows lnk format.
set is_valid_lnk 0
}
if {$is_valid_lnk} {
switch -- $target_type {
file {
set display [dict get $fdict display]
set display "$fshortcut_style$display (shortcut $tgt)" ;#
if {[dict exists $shortcutinfo stringdata command_line_arguments]} {
set display "$fshortcut_style$display (shortcut to $root_tgt [dict get $shortcutinfo stringdata command_line_arguments])"
} else {
set display "$fshortcut_style$display (shortcut $root_tgt)" ;#
}
dict set fdict display $display
lappend finfo_plus $fdict
}
directory {
#target of link is a dir - for display/categorisation purposes we want to see it as a dir
#will be styled later based on membership of dir_shortcuts
#review: we shouldn't see a link to a dir that also has command_line_arguments
#- but if we do, we will just ignore the command_line_arguments for now and treat as a directory shortcut.
lappend dirs $fname
lappend dir_shortcuts $fname
}
}
} else {
#we were unable to get link_target - but we still need to check if it failed the header check (then assume not intended to be a windows shell lnk) or for some other reason.
#we were unable to get link_roottarget - but we still need to check if it failed the header check (then assume not intended to be a windows shell lnk) or for some other reason.
if {[dict exists $shortcutinfo error]} {
if {[dict get $shortcutinfo error] ne "lnk_header_check_failed"} {
#Presumably there is a valid lnk header, but some unexpected error occurred - show it in the display for the file
set linkinfocontent [dict get $linkinfo_content_dict content]
set next_start [dict get $linkinfo_content_dict next_start] ;#location of section following LinkInfo (Location information) - this will be the Data Strings.
set link_target ""
set link_roottarget ""
set linkfields [dict create]
if {$linkinfocontent ne ""} {
set linkfields [LinkInfo_get_fields $linkinfocontent]
set localbase_path [dict get $linkfields localbasepath]
set suffix_path [dict get $linkfields commonpathsuffix]
if {"windows" eq $::tcl_platform(platform)} {
set link_target [file join $localbase_path $suffix_path]
set link_roottarget [file join $localbase_path $suffix_path]
} else {
#review - calling mount and parsing its output every time we parse a .lnk file makes this slow on large folders with .lnk files
# - we may want to cache the results of mount for some period of time or until we detect a change in the system's mounts (e.g. by monitoring /proc/mounts for changes or using a filesystem watcher on /mnt)
if {[regexp {([a-zA-Z]):\\(.*)} $localbase_path _match drive_letter tail]} {
set localbase_path [string map {\\ /} $localbase_path]
set tail [string trimleft [string map {\\ /} $tail] /]
set link_target ""
set link_roottarget ""
#shortcut basepath is a windows path with drive letter - try to resolve it on unix by looking for a corresponding mount from fstab or a point under /mnt
set mountinfo [exec mount]
foreach line [split $mountinfo "\n"] {
#review - a more specific mount target might exist that includes the drive letter as part of the mount point name and is a longer prefix of the localbase_path
#- we should probably look for the longest prefix match rather than just the drive letter
set link_target [file join $mount_point $tail $suffix_path]
set link_roottarget [file join $mount_point $tail $suffix_path]
break
}
}
if {$link_target eq ""} {
if {$link_roottarget eq ""} {
#review - under what circumstances could this happen? If the drive letter doesn't match any mount points, then /mnt/drive_letter should generally already have been found above above
# - However, it may be possible for /mnt/drive_Letter to still exist even if it's not reflected in the output of mount or the output of mount is in an unexpected format.
#nothing in mount result matches the drive letter - try looking for a mount point under /mnt with the drive letter as the name
if {[file exists /mnt/$drive_letter]} {
set link_target [file join /mnt/$drive_letter $tail $suffix_path]
set link_roottarget [file join /mnt/$drive_letter $tail $suffix_path]
} else {
if {$drive_letter eq [string tolower $drive_letter]} {
set op_drive_letter [string toupper $drive_letter]
set op_drive_letter [string tolower $drive_letter]
}
if {[file exists /mnt/$op_drive_letter]} {
set link_target [file join /mnt/$op_drive_letter $tail $suffix_path]
set link_roottarget [file join /mnt/$op_drive_letter $tail $suffix_path]
} else {
#leave as is except for backslashes converted to forward
#- probably won't resolve correctly unless the unix system has a folder named drive_letter: in the current folder with a copy of the original filestructure.
set link_target [file join $localbase_path $suffix_path]
set link_roottarget [file join $localbase_path $suffix_path]
}
}
} else {
#shortcut basepath is a windows path with drive letter and we found a matching mount point - link_target is set to the resolved path
#shortcut basepath is a windows path with drive letter and we found a matching mount point - link_roottarget is set to the resolved path
}
} else {
#shortcut basepath doesn't match expected windows path format - just join it with the suffix and hope for the best
#could be something like a network path or it could be something else entirely
set link_target [file join $localbase_path $suffix_path]
set link_roottarget [file join $localbase_path $suffix_path]
#determine type based on info in the .lnk file, such as file attributes and link flags
#determine target file/directory/link type based on info in the .lnk file, such as file attributes and link flags
#review - a .lnk may target an executable with arguments.
#In this case, the target type may be considered a file (the executable) but it may also be useful to indicate that it's a link to an executable with arguments(?).
if {"DIRECTORY" in $file_attributes} {
return [dict create type directory mechanism file_attributes]"
#don't cache negative result for any relative paths - as they may become valid if the file appears in the relative location, or if the user changes directory and the same relative path points to a different file.
#our only way to do this is by cooperating with the unknown handler.
set auto_execs($name) "for_unknown_handler by punk::auto_exec relative_path - file existence should be re-checked at call time"
return $auto_execs($name)
}
if {[string tolower [file extension $name]] eq ".lnk"} {
#special case .lnk
#todo - consider working directory or other properties of link before launching?
@ -246,11 +249,11 @@ namespace eval punk {
set associnfo [punk::auto_exec::shell_open_command $test_ext]
set valuetype [dict get $associnfo type]
set assoc [dict get $associnfo value]
set ftype [dict get $associnfo filetype]
set windows_file_type [dict get $associnfo filetype]
set run [punk::auto_exec::shell_command_as_tcl_list -type $valuetype $assoc $file] ;# -workingdir [pwd] vs path of script?
@ -269,6 +272,8 @@ namespace eval punk {
}
}
}
#cache negative result for absolute paths - as they will always point to the same location, so if they don't exist now, they won't exist later.
set auto_execs($name) ""
return ""
}
@ -559,7 +564,7 @@ if {![llength [info commands ::ansistring]]} {
package require punk::repl::codethread
package require punk::config
#package require textblock
package require punk::console ;#requires Thread
catch {package require punk::console} ;#requires Thread - will not work in safe interps.
package require punk::ns
package require punk::winpath ;# for windows paths - but has functions that can be called on unix systems
package require punk::repo
@ -5396,27 +5401,54 @@ namespace eval punk {
} else {
set repl_runid [punk::get_repl_runid]
#set ::punk::last_run_display [list]
if {$new eq "(resolve_in_unknown_handler) punk::auto_exec absolute_path required"} {
#re-resolve.
puts "(unknown-handler): auto_execok for $name requires absolute path. Re-resolving $name with absolute path."
set resolved $new
if {[string match "for_unknown_handler *" $new]} {
set ext [file extension $name]
set associnfo [punk::auto_exec::shell_open_command $ext]
set valuetype [dict get $associnfo type]
set assoc [dict get $associnfo value]
set ftype [dict get $associnfo filetype]
set fullpath [file normalize $name]
#at least for .url files - long paths (paths with multiple spaces?) can fail to run. Using the short path seems to fix this.
#This seems hacky but anyway..
set attributes [file attributes $fullpath]
if {[dict exists $attributes -shortname]} {
set fullpath [dict get $attributes -shortname]
if {[string tolower $ext] eq ".lnk"} {
#for .lnk files we can often resolve the target path without needing to execute the shell open command
#- which is desirable because it allows us to avoid the absolute path requirement for unknown-handler auto_execok commands,
#which is desirable because it allows us to support relative paths and paths with environment variables in them
#(e.g for .lnk files that point to executables with environment variables in the path)
set targetinfo [punk::winlnk::resolve $name]
if {[dict exists $targetinfo link_roottarget]} {
set resolved [dict get $targetinfo link_roottarget]
#arguments?
} else {
puts "(unknown-handler): failed to resolve .lnk target for $name. Falling back to shell open command resolution, which may fail if absolute path is required."
}
} else {
#re-resolve.
set associnfo [punk::auto_exec::shell_open_command $ext]
set registry_valuetype [dict get $associnfo type] ;#sz vs expand_sz
set command_spec [dict get $associnfo value]
set windows_file_type [dict get $associnfo filetype]
if {[string match "*absolute_path required" $new]} {
puts "(unknown-handler): auto_execok for $name requires absolute path. Re-resolving $name with absolute path."
set fullpath [file normalize $name]
#at least for .url files - long paths (paths with multiple spaces?) can fail to run. Using the short path seems to fix this.
#This seems hacky but anyway..
set attributes [file attributes $fullpath]
if {[dict exists $attributes -shortname]} {
set fullpath [dict get $attributes -shortname]
}
set resolved [punk::auto_exec::shell_command_as_tcl_list -type $registry_valuetype $command_spec $fullpath]
} else {
#todo
set newnorm [file normalize $name]
puts stderr "(unknown-handler): re-resolving $name with auto_execok $newnorm"
set resolved [auto_execok $newnorm]
}
}
set new [punk::auto_exec::shell_command_as_tcl_list -type $valuetype $assoc $fullpath]
}
if {$resolved eq ""} {
#resolved may be emptyif auto_execok returns an empty string.
dict set ::tcl::UnknownOptions -code error
set ::tcl::UnknownResult "unresolved path '$name'"
#These aliases work fine for interactive use - but the result is always a string int-rep
#interp alias {} ~ {} file join $::env(HOME) ;#HOME must be capitalized to work cross platform (lowercase home works on windows - but probably not elsewhere)
if {$current_chunk ne "" || $current_chunk eq "" && [lindex $quoted end]} {
#we add the current chunk to the result list if it's not empty, or if it is empty but is quoted (because in that case we want to preserve it as an empty argument).
#we add the current chunk to the result list if it's not empty, or if it is empty but is quoted (because in that case we want to preserve it as an empty argument).
set files [glob -nocomplain -dir $folderpath -types f * .*]
}
set globs [list *]
} else {
if {![llength $types_entry] || "d" in $types_entry} {
#we need to check directories for hidden attribute - as on windows, not all dotfiles are hidden, and not all hidden files are dotfiles
set hdirs [glob -nocomplain -dir $folderpath -types {hidden d} $opt_glob]
set dirs [glob -nocomplain -dir $folderpath -types d $opt_glob]
}
if {![llength $types_entry] || "l" in $types_entry} {
set hlinks [glob -nocomplain -dir $folderpath -types {hidden l} $opt_glob]
set links [glob -nocomplain -dir $folderpath -types l $opt_glob] ;#links may have dupes - we don't care. punk::lib::struct_set_diff_unique
}
if {![llength $types_entry] || "f" in $types_entry} {
set hfiles [glob -nocomplain -dir $folderpath -types {hidden f} $opt_glob]
set files [glob -nocomplain -dir $folderpath -types f $opt_glob]
}
set globs [list $opt_glob]
}
#on windows this is a lot of separate globs to perform. Using the du_dirlisting_twapi is preferred for performance on windows - but this is a fallback and for testing.
#if {![llength $types_entry] || "d" in $types_entry} {}
if {!$skip_dirs} {
#we need to check directories for hidden attribute - as on windows, not all dotfiles are hidden, and not all hidden files are dotfiles
set hdirs [glob -nocomplain -dir $folderpath -types {hidden d} {*}$globs]
set dirs [glob -nocomplain -dir $folderpath -types d {*}$globs]
}
if {!$skip_links} {
set hlinks [glob -nocomplain -dir $folderpath -types {hidden l} {*}$globs]
set links [glob -nocomplain -dir $folderpath -types l {*}$globs] ;#links may have dupes - we don't care. punk::lib::struct_set_diff_unique
}
if {!$skip_files} {
set hfiles [glob -nocomplain -dir $folderpath -types {hidden f} {*}$globs]
set files [glob -nocomplain -dir $folderpath -types f {*}$globs]
}
} else {
if {$opt_glob eq "*"} {
#Note - glob operations seem to be faster than looped tests like 'file isdirectory' & 'file readlink'
#set parent [lindex $folders $folderidx]
#set dirs [glob -nocomplain -dir $folderpath -types d * .*]
#set links [glob -nocomplain -dir $folderpath -types l * .*] ;#links may have dupes - we don't care. punk::lib::struct_set_diff_unique
#set files [glob -nocomplain -dir $folderpath -types f * .*]
set globs [list * .*]
} else {
set globs [list $opt_glob]
#set dirs [glob -nocomplain -dir $folderpath -types d $opt_glob]
#set links [glob -nocomplain -dir $folderpath -types l $opt_glob] ;#links may have dupes - we don't care. punk::lib::struct_set_diff_unique
#set files [glob -nocomplain -dir $folderpath -types f $opt_glob]
}
if {![llength $types_entry] || "d" in $types_entry} {
#we need to classify our results - unlike a standard glob * operation which returns all entries in one collection.
#Note - glob operations seem to be faster than looped tests like 'file isdirectory' & 'file readlink'
#however - these are still significantly slower than a single glob with no restrictions - so we want to minimize the number of globs we do
#- but we also want to avoid doing extra work classifying entries that we will end up ignoring based on types/attributes/permissions filters.
if {!$skip_dirs} {
set dirs [glob -nocomplain -dir $folderpath -types d {*}$globs]
}
if {![llength $types_entry] || "l" in $types_entry} {
if {!$skip_links} {
set links [glob -nocomplain -dir $folderpath -types l {*}$globs] ;#links may have dupes - we don't care. punk::lib::struct_set_diff_unique
}
if {![llength $types_entry] || "f" in $types_entry} {
if {!$skip_files} {
set files [glob -nocomplain -dir $folderpath -types f {*}$globs]
}
@ -1957,6 +1974,7 @@ namespace eval punk::du {
set types_entry [list]
set types_attribute [list]
set types_permission [list]
set types_REQUIRED [list]
foreach t $entry_and_attribute_types {
switch -- $t {
f - d - l - p - s - b - c {
@ -2155,7 +2173,7 @@ namespace eval punk::du {
set errors [dict create]
if {"windows" eq $::tcl_platform(platform)} {
if {$opt_glob eq "*"} {
set globs [list * .*]
set globs [list *]
} else {
set globs [list $opt_glob]
}
@ -2295,6 +2313,13 @@ namespace eval punk::du {
#we don't classify anything as 'flaggedhidden' on unix.
#it is a convention for dotfiles rather than a flag - and we'll leave the distinction for the display library
set dirs {}
set hdirs {}
set files {}
set hfiles {}
set links {}
set hlinks {}
if {$opt_glob eq "*"} {
set globs [list * .*]
} else {
@ -2341,6 +2366,7 @@ namespace eval punk::du {
if {"$ft" in $meta_types} {
foreach path [set $lvar] {
if {$has_winpath && [punk::winpath::illegalname_test $path]} {
#review. we don't want to fix the path - we just want classify it as nonportable
set testpath [punk::winpath::illegalname_fix $path]
if {![catch {file stat $testpath arrstat} errM]} {
dict set meta_dict $path [dict create shorttype $ft {*}[array get arrstat]]
@ -2350,7 +2376,7 @@ namespace eval punk::du {
dict set meta_dict $path [dict create shorttype $ft {*}$empty_stat_dict]
}
} else {
#caller may have read perm on the containing folder - but not on child item - so file stat could raise an error
#caller may have permission to read on the containing folder - but not on child item - so file stat could raise an error
if {![catch {file stat $path arrstat} errM]} {
dict set meta_dict $path [dict create shorttype $ft {*}[array get arrstat]]
#It can be slightly expensive (for example involving network calls on windows domains)
variable user_home_cache
set user_home_cache ""
#tilde
#These aliases work fine for interactive use - but the result is always a string internal-rep
#interp alias {} ~ {} file join $::env(HOME) ;#HOME must be capitalized to work cross platform (lowercase home works on windows - but probably not elsewhere)
"Return user's home directory as the process sees it"\
-help\
"Return the user's home directory path as the process sees it.
(This is not always the same as ::env(HOME))
With additional arguments, return the path obtained by joining
the user's home directory with the supplied arguments.
usage e.g
cd [~]
(change to user's home)
.// [~] .config
(change to .config directory within the user's home
and list contents.)
equivalently:
gohome .config
(gohome uses the output of ~ to determine the home directory)
If the home directory cannot be determined due to the environment
in which the process is running, an error will be raised, as returning
an empty string is not a useful result and can cause issues if used as a path.
"
@opts
@values -min 0 -max -1
arg -type any -optional 1 -multiple 1
}
}
proc ~ {args} {
#review - HOME may be undefined or have been set to another value by other tools or the parent process.
#The process may even be running in a context where there is no home directory - e.g a container with no users, or a system service context.
#(we may be in a safe interp - which generally won't have env vars or filesystem access)
variable user_home_cache
if {$user_home_cache ne ""} {
set hdir $user_home_cache
#we still need to process args to join them to the home directory - but we can skip all the work of determining the home directory again.
} else {
set hdir ""
if {[catch {auto_execok whoami} whoami_exe]} {
set whoami_exe ""
}
if {$whoami_exe eq ""} {
#try env USER or USERNAME - these are commonly set to the username on many platforms - but may not be set in all contexts.
if {[info exists ::env(USER)]} {
set user $::env(USER)
} elseif {[info exists ::env(USERNAME)]} {
set user $::env(USERNAME)
} else {
set user ""
}
} else {
#set user [exec {*}$whoami_exe]
if {[catch {exec {*}$whoami_exe} user]} {
set user ""
}
}
if {[string trim $user] ne ""} {
#normalize user for use with 'file tildeexpand ~<user>'
#on windows, whoami may return DOMAIN\USER
#for tildeexpand to work, we need to convert this to USER@DOMAIN
if {"windows" eq $::tcl_platform(platform)} {
set parts [split $user "\\"]
#we expect only 1 or 2 parts
if {[llength $parts] == 2} {
lassign $parts domain username
#if we use username@domain format - we get the domain controller's view of our home directory - which can be different from the local machine's view of our home directory.
#e.g file tildeexpand ~jnoble@corp can return a local non existant path like c:/users/jnoble
#but it may be c:/users/jnoble.corp - or c:/users/something_else_entirely depending on how the local machine is configured.
#It may be that the domain controller is correct if it returns a network path like \\server\users\jnoble ??
#Network paths are not necessarily the preferred practive as of 2026 - but may still exist.
#Microsoft is encouraging the use of cloud systems - but it it unknown at this stage what sort of paths can be returned.
#REVIEW
set domainuser "$username@$domain"
#we can run file tildeexpand with username@domain and test if the path is writable
#this reduces the possibility that there happens to be a local user with the same name as the domain user - which would cause us to get the wrong home directory.
if {![catch {file tildeexpand ~$domainuser} path]} {
if {[file writable $path]} {
set user $domainuser
set hdir $path ;#set hdir so we don't re-lookup below.
}
}
if {$hdir eq ""} {
#for now we will use the unqualified username.
set user $username
}
} elseif {[llength $parts] == 1} {
set user [lindex $parts 0]
} else {
#unexpected format - emit warning
puts stderr "Warning: Unexpected format of username '$user' returned by whoami. Expected format 'DOMAIN\\USER' or 'USER'. Unable to determine home directory for this user."
set user ""
}
}
#only enter this branch if hdir wasn't resolved above for windows domain user.
if {$hdir eq "" && $user ne ""} {
#we use file tildeexpand ~user because the intention is stated in the tcl source as:
#* the intent is to retrieve (as on Unix) the system's view
#* of the home irrespective of environment settings of HOME
#* and USERPROFILE.
# - this aligns with our intention here.
if {![catch {file tildeexpand ~$user} path]} {
set hdir [punk::valcopy $path]
} else {
#tcl <= 8.6 may not have file tildeexpand.
#we now have no option but to rely on environment variables - which may not be set or may be set to an incorrect value
#as tcl <= 8.6 needs to be supported - but isn't the primary target we will allow this fallback - but raise a warning as this is not ideal.
puts stderr "punk::nav::fs::~ Warning: Unable to determine home directory for user '$user' using 'file tildeexpand ~$user'. Falling back to environment variables, which may not be set or may be incorrect. Consider upgrading to Tcl 9.0 or later for improved reliability."
if {"windows" eq $::tcl_platform(platform)} {
if {[info exists ::env(USERPROFILE)]} {
set hdir [punk::valcopy $::env(USERPROFILE)]
} else {
set hdir ""
}
} else {
if {[info exists ::env(HOME)]} {
set hdir [punk::valcopy $::env(HOME)]
} else {
set hdir ""
}
}
}
}
}
}
if {$hdir eq ""} {
error "punk::nav::fs::~ Unable to determine home directory for user '$user'. Consider upgrading to Tcl 9.0 or later for improved reliability in home directory detection."
}
file pathtype $hdir ;#flips internal-rep to path
if {![file isdirectory $hdir]} {
#file isdirectory should also return true if the path exists and is a symlink to a directory - but if it doesn't exist at all - or is a file - then we have a problem.
error "punk::nav::fs::~ Determined home directory path '$hdir' does not exist (or is not a directory)."
} else {
if {![file readable $hdir]} {
error "punk::nav::fs::~ Determined home directory path '$hdir' is not readable."
}
}
set user_home_cache $hdir ;#cache only the home directory.
set d $hdir
#use the file join 2-arg optimisation to avoid losing path-rep - probably doesn't give any advantage on all Tcl versions
#review - for what versions does/did the 2-arg version of file join not just return a string?
error "punk::nav::fs::d/new $error_string\n$num_created directories out of [llength $fullpath_list] were created successfully before the error was encountered."
error "punk::nav::fs::newdir $error_string\n$num_created directories out of [llength $fullpath_list] were created successfully before the error was encountered."
}
#display summaries of created directories (which may have already existed) by reusing d/ to get info on them.
set query_paths [lmap v $paths {string cat $v "/*"}]
#no link_target - probably an ordinary file - but there could have been some other error in reading the binary windows lnk format.
#no link_roottarget - probably an ordinary file - but there could have been some other error in reading the binary windows lnk format.
set is_valid_lnk 0
}
if {$is_valid_lnk} {
switch -- $target_type {
file {
set display [dict get $fdict display]
set display "$fshortcut_style$display (shortcut $tgt)" ;#
if {[dict exists $shortcutinfo stringdata command_line_arguments]} {
set display "$fshortcut_style$display (shortcut to $root_tgt [dict get $shortcutinfo stringdata command_line_arguments])"
} else {
set display "$fshortcut_style$display (shortcut $root_tgt)" ;#
}
dict set fdict display $display
lappend finfo_plus $fdict
}
directory {
#target of link is a dir - for display/categorisation purposes we want to see it as a dir
#will be styled later based on membership of dir_shortcuts
#review: we shouldn't see a link to a dir that also has command_line_arguments
#- but if we do, we will just ignore the command_line_arguments for now and treat as a directory shortcut.
lappend dirs $fname
lappend dir_shortcuts $fname
}
}
} else {
#we were unable to get link_target - but we still need to check if it failed the header check (then assume not intended to be a windows shell lnk) or for some other reason.
#we were unable to get link_roottarget - but we still need to check if it failed the header check (then assume not intended to be a windows shell lnk) or for some other reason.
if {[dict exists $shortcutinfo error]} {
if {[dict get $shortcutinfo error] ne "lnk_header_check_failed"} {
#Presumably there is a valid lnk header, but some unexpected error occurred - show it in the display for the file
set linkinfocontent [dict get $linkinfo_content_dict content]
set next_start [dict get $linkinfo_content_dict next_start] ;#location of section following LinkInfo (Location information) - this will be the Data Strings.
set link_target ""
set link_roottarget ""
set linkfields [dict create]
if {$linkinfocontent ne ""} {
set linkfields [LinkInfo_get_fields $linkinfocontent]
set localbase_path [dict get $linkfields localbasepath]
set suffix_path [dict get $linkfields commonpathsuffix]
if {"windows" eq $::tcl_platform(platform)} {
set link_target [file join $localbase_path $suffix_path]
set link_roottarget [file join $localbase_path $suffix_path]
} else {
#review - calling mount and parsing its output every time we parse a .lnk file makes this slow on large folders with .lnk files
# - we may want to cache the results of mount for some period of time or until we detect a change in the system's mounts (e.g. by monitoring /proc/mounts for changes or using a filesystem watcher on /mnt)
if {[regexp {([a-zA-Z]):\\(.*)} $localbase_path _match drive_letter tail]} {
set localbase_path [string map {\\ /} $localbase_path]
set tail [string trimleft [string map {\\ /} $tail] /]
set link_target ""
set link_roottarget ""
#shortcut basepath is a windows path with drive letter - try to resolve it on unix by looking for a corresponding mount from fstab or a point under /mnt
set mountinfo [exec mount]
foreach line [split $mountinfo "\n"] {
#review - a more specific mount target might exist that includes the drive letter as part of the mount point name and is a longer prefix of the localbase_path
#- we should probably look for the longest prefix match rather than just the drive letter
set link_target [file join $mount_point $tail $suffix_path]
set link_roottarget [file join $mount_point $tail $suffix_path]
break
}
}
if {$link_target eq ""} {
if {$link_roottarget eq ""} {
#review - under what circumstances could this happen? If the drive letter doesn't match any mount points, then /mnt/drive_letter should generally already have been found above above
# - However, it may be possible for /mnt/drive_Letter to still exist even if it's not reflected in the output of mount or the output of mount is in an unexpected format.
#nothing in mount result matches the drive letter - try looking for a mount point under /mnt with the drive letter as the name
if {[file exists /mnt/$drive_letter]} {
set link_target [file join /mnt/$drive_letter $tail $suffix_path]
set link_roottarget [file join /mnt/$drive_letter $tail $suffix_path]
} else {
if {$drive_letter eq [string tolower $drive_letter]} {
set op_drive_letter [string toupper $drive_letter]
set op_drive_letter [string tolower $drive_letter]
}
if {[file exists /mnt/$op_drive_letter]} {
set link_target [file join /mnt/$op_drive_letter $tail $suffix_path]
set link_roottarget [file join /mnt/$op_drive_letter $tail $suffix_path]
} else {
#leave as is except for backslashes converted to forward
#- probably won't resolve correctly unless the unix system has a folder named drive_letter: in the current folder with a copy of the original filestructure.
set link_target [file join $localbase_path $suffix_path]
set link_roottarget [file join $localbase_path $suffix_path]
}
}
} else {
#shortcut basepath is a windows path with drive letter and we found a matching mount point - link_target is set to the resolved path
#shortcut basepath is a windows path with drive letter and we found a matching mount point - link_roottarget is set to the resolved path
}
} else {
#shortcut basepath doesn't match expected windows path format - just join it with the suffix and hope for the best
#could be something like a network path or it could be something else entirely
set link_target [file join $localbase_path $suffix_path]
set link_roottarget [file join $localbase_path $suffix_path]
#determine type based on info in the .lnk file, such as file attributes and link flags
#determine target file/directory/link type based on info in the .lnk file, such as file attributes and link flags
#review - a .lnk may target an executable with arguments.
#In this case, the target type may be considered a file (the executable) but it may also be useful to indicate that it's a link to an executable with arguments(?).
if {"DIRECTORY" in $file_attributes} {
return [dict create type directory mechanism file_attributes]"
set command [uplevel 1 [list namespace which $command]]
if {$command eq ""} {
#review
puts stderr "commandstack::rename_command no rename performed for command '$command' by '$renamer'. command '$command' not found in calling context. Ensure command name is fully qualified or that command exists."
#add something to stack?
return [dict create implementation ""]
}
set mungedcommand [string map {:: _ns_} $command]
set mungedrenamer [string map {:: _ns_} $renamer]
variable all_stacks
@ -284,7 +290,8 @@ namespace eval commandstack {
]
if {![dict get $nextinfo do_rename]} {
#review
puts stderr "no rename performed"
puts stderr "commandstack::rename_command no rename performed for command '$command' by '$renamer'"
#don't cache negative result for any relative paths - as they may become valid if the file appears in the relative location, or if the user changes directory and the same relative path points to a different file.
#our only way to do this is by cooperating with the unknown handler.
set auto_execs($name) "for_unknown_handler by punk::auto_exec relative_path - file existence should be re-checked at call time"
return $auto_execs($name)
}
if {[string tolower [file extension $name]] eq ".lnk"} {
#special case .lnk
#todo - consider working directory or other properties of link before launching?
@ -246,11 +249,11 @@ namespace eval punk {
set associnfo [punk::auto_exec::shell_open_command $test_ext]
set valuetype [dict get $associnfo type]
set assoc [dict get $associnfo value]
set ftype [dict get $associnfo filetype]
set windows_file_type [dict get $associnfo filetype]
set run [punk::auto_exec::shell_command_as_tcl_list -type $valuetype $assoc $file] ;# -workingdir [pwd] vs path of script?
@ -269,6 +272,8 @@ namespace eval punk {
}
}
}
#cache negative result for absolute paths - as they will always point to the same location, so if they don't exist now, they won't exist later.
set auto_execs($name) ""
return ""
}
@ -559,7 +564,7 @@ if {![llength [info commands ::ansistring]]} {
package require punk::repl::codethread
package require punk::config
#package require textblock
package require punk::console ;#requires Thread
catch {package require punk::console} ;#requires Thread - will not work in safe interps.
package require punk::ns
package require punk::winpath ;# for windows paths - but has functions that can be called on unix systems
package require punk::repo
@ -5396,27 +5401,54 @@ namespace eval punk {
} else {
set repl_runid [punk::get_repl_runid]
#set ::punk::last_run_display [list]
if {$new eq "(resolve_in_unknown_handler) punk::auto_exec absolute_path required"} {
#re-resolve.
puts "(unknown-handler): auto_execok for $name requires absolute path. Re-resolving $name with absolute path."
set resolved $new
if {[string match "for_unknown_handler *" $new]} {
set ext [file extension $name]
set associnfo [punk::auto_exec::shell_open_command $ext]
set valuetype [dict get $associnfo type]
set assoc [dict get $associnfo value]
set ftype [dict get $associnfo filetype]
set fullpath [file normalize $name]
#at least for .url files - long paths (paths with multiple spaces?) can fail to run. Using the short path seems to fix this.
#This seems hacky but anyway..
set attributes [file attributes $fullpath]
if {[dict exists $attributes -shortname]} {
set fullpath [dict get $attributes -shortname]
if {[string tolower $ext] eq ".lnk"} {
#for .lnk files we can often resolve the target path without needing to execute the shell open command
#- which is desirable because it allows us to avoid the absolute path requirement for unknown-handler auto_execok commands,
#which is desirable because it allows us to support relative paths and paths with environment variables in them
#(e.g for .lnk files that point to executables with environment variables in the path)
set targetinfo [punk::winlnk::resolve $name]
if {[dict exists $targetinfo link_roottarget]} {
set resolved [dict get $targetinfo link_roottarget]
#arguments?
} else {
puts "(unknown-handler): failed to resolve .lnk target for $name. Falling back to shell open command resolution, which may fail if absolute path is required."
}
} else {
#re-resolve.
set associnfo [punk::auto_exec::shell_open_command $ext]
set registry_valuetype [dict get $associnfo type] ;#sz vs expand_sz
set command_spec [dict get $associnfo value]
set windows_file_type [dict get $associnfo filetype]
if {[string match "*absolute_path required" $new]} {
puts "(unknown-handler): auto_execok for $name requires absolute path. Re-resolving $name with absolute path."
set fullpath [file normalize $name]
#at least for .url files - long paths (paths with multiple spaces?) can fail to run. Using the short path seems to fix this.
#This seems hacky but anyway..
set attributes [file attributes $fullpath]
if {[dict exists $attributes -shortname]} {
set fullpath [dict get $attributes -shortname]
}
set resolved [punk::auto_exec::shell_command_as_tcl_list -type $registry_valuetype $command_spec $fullpath]
} else {
#todo
set newnorm [file normalize $name]
puts stderr "(unknown-handler): re-resolving $name with auto_execok $newnorm"
set resolved [auto_execok $newnorm]
}
}
set new [punk::auto_exec::shell_command_as_tcl_list -type $valuetype $assoc $fullpath]
}
if {$resolved eq ""} {
#resolved may be emptyif auto_execok returns an empty string.
dict set ::tcl::UnknownOptions -code error
set ::tcl::UnknownResult "unresolved path '$name'"
#These aliases work fine for interactive use - but the result is always a string int-rep
#interp alias {} ~ {} file join $::env(HOME) ;#HOME must be capitalized to work cross platform (lowercase home works on windows - but probably not elsewhere)
if {$current_chunk ne "" || $current_chunk eq "" && [lindex $quoted end]} {
#we add the current chunk to the result list if it's not empty, or if it is empty but is quoted (because in that case we want to preserve it as an empty argument).
#we add the current chunk to the result list if it's not empty, or if it is empty but is quoted (because in that case we want to preserve it as an empty argument).
set files [glob -nocomplain -dir $folderpath -types f * .*]
}
set globs [list *]
} else {
if {![llength $types_entry] || "d" in $types_entry} {
#we need to check directories for hidden attribute - as on windows, not all dotfiles are hidden, and not all hidden files are dotfiles
set hdirs [glob -nocomplain -dir $folderpath -types {hidden d} $opt_glob]
set dirs [glob -nocomplain -dir $folderpath -types d $opt_glob]
}
if {![llength $types_entry] || "l" in $types_entry} {
set hlinks [glob -nocomplain -dir $folderpath -types {hidden l} $opt_glob]
set links [glob -nocomplain -dir $folderpath -types l $opt_glob] ;#links may have dupes - we don't care. punk::lib::struct_set_diff_unique
}
if {![llength $types_entry] || "f" in $types_entry} {
set hfiles [glob -nocomplain -dir $folderpath -types {hidden f} $opt_glob]
set files [glob -nocomplain -dir $folderpath -types f $opt_glob]
}
set globs [list $opt_glob]
}
#on windows this is a lot of separate globs to perform. Using the du_dirlisting_twapi is preferred for performance on windows - but this is a fallback and for testing.
#if {![llength $types_entry] || "d" in $types_entry} {}
if {!$skip_dirs} {
#we need to check directories for hidden attribute - as on windows, not all dotfiles are hidden, and not all hidden files are dotfiles
set hdirs [glob -nocomplain -dir $folderpath -types {hidden d} {*}$globs]
set dirs [glob -nocomplain -dir $folderpath -types d {*}$globs]
}
if {!$skip_links} {
set hlinks [glob -nocomplain -dir $folderpath -types {hidden l} {*}$globs]
set links [glob -nocomplain -dir $folderpath -types l {*}$globs] ;#links may have dupes - we don't care. punk::lib::struct_set_diff_unique
}
if {!$skip_files} {
set hfiles [glob -nocomplain -dir $folderpath -types {hidden f} {*}$globs]
set files [glob -nocomplain -dir $folderpath -types f {*}$globs]
}
} else {
if {$opt_glob eq "*"} {
#Note - glob operations seem to be faster than looped tests like 'file isdirectory' & 'file readlink'
#set parent [lindex $folders $folderidx]
#set dirs [glob -nocomplain -dir $folderpath -types d * .*]
#set links [glob -nocomplain -dir $folderpath -types l * .*] ;#links may have dupes - we don't care. punk::lib::struct_set_diff_unique
#set files [glob -nocomplain -dir $folderpath -types f * .*]
set globs [list * .*]
} else {
set globs [list $opt_glob]
#set dirs [glob -nocomplain -dir $folderpath -types d $opt_glob]
#set links [glob -nocomplain -dir $folderpath -types l $opt_glob] ;#links may have dupes - we don't care. punk::lib::struct_set_diff_unique
#set files [glob -nocomplain -dir $folderpath -types f $opt_glob]
}
if {![llength $types_entry] || "d" in $types_entry} {
#we need to classify our results - unlike a standard glob * operation which returns all entries in one collection.
#Note - glob operations seem to be faster than looped tests like 'file isdirectory' & 'file readlink'
#however - these are still significantly slower than a single glob with no restrictions - so we want to minimize the number of globs we do
#- but we also want to avoid doing extra work classifying entries that we will end up ignoring based on types/attributes/permissions filters.
if {!$skip_dirs} {
set dirs [glob -nocomplain -dir $folderpath -types d {*}$globs]
}
if {![llength $types_entry] || "l" in $types_entry} {
if {!$skip_links} {
set links [glob -nocomplain -dir $folderpath -types l {*}$globs] ;#links may have dupes - we don't care. punk::lib::struct_set_diff_unique
}
if {![llength $types_entry] || "f" in $types_entry} {
if {!$skip_files} {
set files [glob -nocomplain -dir $folderpath -types f {*}$globs]
}
@ -1957,6 +1974,7 @@ namespace eval punk::du {
set types_entry [list]
set types_attribute [list]
set types_permission [list]
set types_REQUIRED [list]
foreach t $entry_and_attribute_types {
switch -- $t {
f - d - l - p - s - b - c {
@ -2155,7 +2173,7 @@ namespace eval punk::du {
set errors [dict create]
if {"windows" eq $::tcl_platform(platform)} {
if {$opt_glob eq "*"} {
set globs [list * .*]
set globs [list *]
} else {
set globs [list $opt_glob]
}
@ -2295,6 +2313,13 @@ namespace eval punk::du {
#we don't classify anything as 'flaggedhidden' on unix.
#it is a convention for dotfiles rather than a flag - and we'll leave the distinction for the display library
set dirs {}
set hdirs {}
set files {}
set hfiles {}
set links {}
set hlinks {}
if {$opt_glob eq "*"} {
set globs [list * .*]
} else {
@ -2341,6 +2366,7 @@ namespace eval punk::du {
if {"$ft" in $meta_types} {
foreach path [set $lvar] {
if {$has_winpath && [punk::winpath::illegalname_test $path]} {
#review. we don't want to fix the path - we just want classify it as nonportable
set testpath [punk::winpath::illegalname_fix $path]
if {![catch {file stat $testpath arrstat} errM]} {
dict set meta_dict $path [dict create shorttype $ft {*}[array get arrstat]]
@ -2350,7 +2376,7 @@ namespace eval punk::du {
dict set meta_dict $path [dict create shorttype $ft {*}$empty_stat_dict]
}
} else {
#caller may have read perm on the containing folder - but not on child item - so file stat could raise an error
#caller may have permission to read on the containing folder - but not on child item - so file stat could raise an error
if {![catch {file stat $path arrstat} errM]} {
dict set meta_dict $path [dict create shorttype $ft {*}[array get arrstat]]
#It can be slightly expensive (for example involving network calls on windows domains)
variable user_home_cache
set user_home_cache ""
#tilde
#These aliases work fine for interactive use - but the result is always a string internal-rep
#interp alias {} ~ {} file join $::env(HOME) ;#HOME must be capitalized to work cross platform (lowercase home works on windows - but probably not elsewhere)
"Return user's home directory as the process sees it"\
-help\
"Return the user's home directory path as the process sees it.
(This is not always the same as ::env(HOME))
With additional arguments, return the path obtained by joining
the user's home directory with the supplied arguments.
usage e.g
cd [~]
(change to user's home)
.// [~] .config
(change to .config directory within the user's home
and list contents.)
equivalently:
gohome .config
(gohome uses the output of ~ to determine the home directory)
If the home directory cannot be determined due to the environment
in which the process is running, an error will be raised, as returning
an empty string is not a useful result and can cause issues if used as a path.
"
@opts
@values -min 0 -max -1
arg -type any -optional 1 -multiple 1
}
}
proc ~ {args} {
#review - HOME may be undefined or have been set to another value by other tools or the parent process.
#The process may even be running in a context where there is no home directory - e.g a container with no users, or a system service context.
#(we may be in a safe interp - which generally won't have env vars or filesystem access)
variable user_home_cache
if {$user_home_cache ne ""} {
set hdir $user_home_cache
#we still need to process args to join them to the home directory - but we can skip all the work of determining the home directory again.
} else {
set hdir ""
if {[catch {auto_execok whoami} whoami_exe]} {
set whoami_exe ""
}
if {$whoami_exe eq ""} {
#try env USER or USERNAME - these are commonly set to the username on many platforms - but may not be set in all contexts.
if {[info exists ::env(USER)]} {
set user $::env(USER)
} elseif {[info exists ::env(USERNAME)]} {
set user $::env(USERNAME)
} else {
set user ""
}
} else {
#set user [exec {*}$whoami_exe]
if {[catch {exec {*}$whoami_exe} user]} {
set user ""
}
}
if {[string trim $user] ne ""} {
#normalize user for use with 'file tildeexpand ~<user>'
#on windows, whoami may return DOMAIN\USER
#for tildeexpand to work, we need to convert this to USER@DOMAIN
if {"windows" eq $::tcl_platform(platform)} {
set parts [split $user "\\"]
#we expect only 1 or 2 parts
if {[llength $parts] == 2} {
lassign $parts domain username
#if we use username@domain format - we get the domain controller's view of our home directory - which can be different from the local machine's view of our home directory.
#e.g file tildeexpand ~jnoble@corp can return a local non existant path like c:/users/jnoble
#but it may be c:/users/jnoble.corp - or c:/users/something_else_entirely depending on how the local machine is configured.
#It may be that the domain controller is correct if it returns a network path like \\server\users\jnoble ??
#Network paths are not necessarily the preferred practive as of 2026 - but may still exist.
#Microsoft is encouraging the use of cloud systems - but it it unknown at this stage what sort of paths can be returned.
#REVIEW
set domainuser "$username@$domain"
#we can run file tildeexpand with username@domain and test if the path is writable
#this reduces the possibility that there happens to be a local user with the same name as the domain user - which would cause us to get the wrong home directory.
if {![catch {file tildeexpand ~$domainuser} path]} {
if {[file writable $path]} {
set user $domainuser
set hdir $path ;#set hdir so we don't re-lookup below.
}
}
if {$hdir eq ""} {
#for now we will use the unqualified username.
set user $username
}
} elseif {[llength $parts] == 1} {
set user [lindex $parts 0]
} else {
#unexpected format - emit warning
puts stderr "Warning: Unexpected format of username '$user' returned by whoami. Expected format 'DOMAIN\\USER' or 'USER'. Unable to determine home directory for this user."
set user ""
}
}
#only enter this branch if hdir wasn't resolved above for windows domain user.
if {$hdir eq "" && $user ne ""} {
#we use file tildeexpand ~user because the intention is stated in the tcl source as:
#* the intent is to retrieve (as on Unix) the system's view
#* of the home irrespective of environment settings of HOME
#* and USERPROFILE.
# - this aligns with our intention here.
if {![catch {file tildeexpand ~$user} path]} {
set hdir [punk::valcopy $path]
} else {
#tcl <= 8.6 may not have file tildeexpand.
#we now have no option but to rely on environment variables - which may not be set or may be set to an incorrect value
#as tcl <= 8.6 needs to be supported - but isn't the primary target we will allow this fallback - but raise a warning as this is not ideal.
puts stderr "punk::nav::fs::~ Warning: Unable to determine home directory for user '$user' using 'file tildeexpand ~$user'. Falling back to environment variables, which may not be set or may be incorrect. Consider upgrading to Tcl 9.0 or later for improved reliability."
if {"windows" eq $::tcl_platform(platform)} {
if {[info exists ::env(USERPROFILE)]} {
set hdir [punk::valcopy $::env(USERPROFILE)]
} else {
set hdir ""
}
} else {
if {[info exists ::env(HOME)]} {
set hdir [punk::valcopy $::env(HOME)]
} else {
set hdir ""
}
}
}
}
}
}
if {$hdir eq ""} {
error "punk::nav::fs::~ Unable to determine home directory for user '$user'. Consider upgrading to Tcl 9.0 or later for improved reliability in home directory detection."
}
file pathtype $hdir ;#flips internal-rep to path
if {![file isdirectory $hdir]} {
#file isdirectory should also return true if the path exists and is a symlink to a directory - but if it doesn't exist at all - or is a file - then we have a problem.
error "punk::nav::fs::~ Determined home directory path '$hdir' does not exist (or is not a directory)."
} else {
if {![file readable $hdir]} {
error "punk::nav::fs::~ Determined home directory path '$hdir' is not readable."
}
}
set user_home_cache $hdir ;#cache only the home directory.
set d $hdir
#use the file join 2-arg optimisation to avoid losing path-rep - probably doesn't give any advantage on all Tcl versions
#review - for what versions does/did the 2-arg version of file join not just return a string?
error "punk::nav::fs::d/new $error_string\n$num_created directories out of [llength $fullpath_list] were created successfully before the error was encountered."
error "punk::nav::fs::newdir $error_string\n$num_created directories out of [llength $fullpath_list] were created successfully before the error was encountered."
}
#display summaries of created directories (which may have already existed) by reusing d/ to get info on them.
set query_paths [lmap v $paths {string cat $v "/*"}]
#no link_target - probably an ordinary file - but there could have been some other error in reading the binary windows lnk format.
#no link_roottarget - probably an ordinary file - but there could have been some other error in reading the binary windows lnk format.
set is_valid_lnk 0
}
if {$is_valid_lnk} {
switch -- $target_type {
file {
set display [dict get $fdict display]
set display "$fshortcut_style$display (shortcut $tgt)" ;#
if {[dict exists $shortcutinfo stringdata command_line_arguments]} {
set display "$fshortcut_style$display (shortcut to $root_tgt [dict get $shortcutinfo stringdata command_line_arguments])"
} else {
set display "$fshortcut_style$display (shortcut $root_tgt)" ;#
}
dict set fdict display $display
lappend finfo_plus $fdict
}
directory {
#target of link is a dir - for display/categorisation purposes we want to see it as a dir
#will be styled later based on membership of dir_shortcuts
#review: we shouldn't see a link to a dir that also has command_line_arguments
#- but if we do, we will just ignore the command_line_arguments for now and treat as a directory shortcut.
lappend dirs $fname
lappend dir_shortcuts $fname
}
}
} else {
#we were unable to get link_target - but we still need to check if it failed the header check (then assume not intended to be a windows shell lnk) or for some other reason.
#we were unable to get link_roottarget - but we still need to check if it failed the header check (then assume not intended to be a windows shell lnk) or for some other reason.
if {[dict exists $shortcutinfo error]} {
if {[dict get $shortcutinfo error] ne "lnk_header_check_failed"} {
#Presumably there is a valid lnk header, but some unexpected error occurred - show it in the display for the file
set linkinfocontent [dict get $linkinfo_content_dict content]
set next_start [dict get $linkinfo_content_dict next_start] ;#location of section following LinkInfo (Location information) - this will be the Data Strings.
set link_target ""
set link_roottarget ""
set linkfields [dict create]
if {$linkinfocontent ne ""} {
set linkfields [LinkInfo_get_fields $linkinfocontent]
set localbase_path [dict get $linkfields localbasepath]
set suffix_path [dict get $linkfields commonpathsuffix]
if {"windows" eq $::tcl_platform(platform)} {
set link_target [file join $localbase_path $suffix_path]
set link_roottarget [file join $localbase_path $suffix_path]
} else {
#review - calling mount and parsing its output every time we parse a .lnk file makes this slow on large folders with .lnk files
# - we may want to cache the results of mount for some period of time or until we detect a change in the system's mounts (e.g. by monitoring /proc/mounts for changes or using a filesystem watcher on /mnt)
if {[regexp {([a-zA-Z]):\\(.*)} $localbase_path _match drive_letter tail]} {
set localbase_path [string map {\\ /} $localbase_path]
set tail [string trimleft [string map {\\ /} $tail] /]
set link_target ""
set link_roottarget ""
#shortcut basepath is a windows path with drive letter - try to resolve it on unix by looking for a corresponding mount from fstab or a point under /mnt
set mountinfo [exec mount]
foreach line [split $mountinfo "\n"] {
#review - a more specific mount target might exist that includes the drive letter as part of the mount point name and is a longer prefix of the localbase_path
#- we should probably look for the longest prefix match rather than just the drive letter
set link_target [file join $mount_point $tail $suffix_path]
set link_roottarget [file join $mount_point $tail $suffix_path]
break
}
}
if {$link_target eq ""} {
if {$link_roottarget eq ""} {
#review - under what circumstances could this happen? If the drive letter doesn't match any mount points, then /mnt/drive_letter should generally already have been found above above
# - However, it may be possible for /mnt/drive_Letter to still exist even if it's not reflected in the output of mount or the output of mount is in an unexpected format.
#nothing in mount result matches the drive letter - try looking for a mount point under /mnt with the drive letter as the name
if {[file exists /mnt/$drive_letter]} {
set link_target [file join /mnt/$drive_letter $tail $suffix_path]
set link_roottarget [file join /mnt/$drive_letter $tail $suffix_path]
} else {
if {$drive_letter eq [string tolower $drive_letter]} {
set op_drive_letter [string toupper $drive_letter]
set op_drive_letter [string tolower $drive_letter]
}
if {[file exists /mnt/$op_drive_letter]} {
set link_target [file join /mnt/$op_drive_letter $tail $suffix_path]
set link_roottarget [file join /mnt/$op_drive_letter $tail $suffix_path]
} else {
#leave as is except for backslashes converted to forward
#- probably won't resolve correctly unless the unix system has a folder named drive_letter: in the current folder with a copy of the original filestructure.
set link_target [file join $localbase_path $suffix_path]
set link_roottarget [file join $localbase_path $suffix_path]
}
}
} else {
#shortcut basepath is a windows path with drive letter and we found a matching mount point - link_target is set to the resolved path
#shortcut basepath is a windows path with drive letter and we found a matching mount point - link_roottarget is set to the resolved path
}
} else {
#shortcut basepath doesn't match expected windows path format - just join it with the suffix and hope for the best
#could be something like a network path or it could be something else entirely
set link_target [file join $localbase_path $suffix_path]
set link_roottarget [file join $localbase_path $suffix_path]
#determine type based on info in the .lnk file, such as file attributes and link flags
#determine target file/directory/link type based on info in the .lnk file, such as file attributes and link flags
#review - a .lnk may target an executable with arguments.
#In this case, the target type may be considered a file (the executable) but it may also be useful to indicate that it's a link to an executable with arguments(?).
if {"DIRECTORY" in $file_attributes} {
return [dict create type directory mechanism file_attributes]"
set command [uplevel 1 [list namespace which $command]]
if {$command eq ""} {
#review
puts stderr "commandstack::rename_command no rename performed for command '$command' by '$renamer'. command '$command' not found in calling context. Ensure command name is fully qualified or that command exists."
#add something to stack?
return [dict create implementation ""]
}
set mungedcommand [string map {:: _ns_} $command]
set mungedrenamer [string map {:: _ns_} $renamer]
variable all_stacks
@ -284,7 +290,8 @@ namespace eval commandstack {
]
if {![dict get $nextinfo do_rename]} {
#review
puts stderr "no rename performed"
puts stderr "commandstack::rename_command no rename performed for command '$command' by '$renamer'"
#don't cache negative result for any relative paths - as they may become valid if the file appears in the relative location, or if the user changes directory and the same relative path points to a different file.
#our only way to do this is by cooperating with the unknown handler.
set auto_execs($name) "for_unknown_handler by punk::auto_exec relative_path - file existence should be re-checked at call time"
return $auto_execs($name)
}
if {[string tolower [file extension $name]] eq ".lnk"} {
#special case .lnk
#todo - consider working directory or other properties of link before launching?
@ -246,11 +249,11 @@ namespace eval punk {
set associnfo [punk::auto_exec::shell_open_command $test_ext]
set valuetype [dict get $associnfo type]
set assoc [dict get $associnfo value]
set ftype [dict get $associnfo filetype]
set windows_file_type [dict get $associnfo filetype]
set run [punk::auto_exec::shell_command_as_tcl_list -type $valuetype $assoc $file] ;# -workingdir [pwd] vs path of script?
@ -269,6 +272,8 @@ namespace eval punk {
}
}
}
#cache negative result for absolute paths - as they will always point to the same location, so if they don't exist now, they won't exist later.
set auto_execs($name) ""
return ""
}
@ -559,7 +564,7 @@ if {![llength [info commands ::ansistring]]} {
package require punk::repl::codethread
package require punk::config
#package require textblock
package require punk::console ;#requires Thread
catch {package require punk::console} ;#requires Thread - will not work in safe interps.
package require punk::ns
package require punk::winpath ;# for windows paths - but has functions that can be called on unix systems
package require punk::repo
@ -5396,27 +5401,54 @@ namespace eval punk {
} else {
set repl_runid [punk::get_repl_runid]
#set ::punk::last_run_display [list]
if {$new eq "(resolve_in_unknown_handler) punk::auto_exec absolute_path required"} {
#re-resolve.
puts "(unknown-handler): auto_execok for $name requires absolute path. Re-resolving $name with absolute path."
set resolved $new
if {[string match "for_unknown_handler *" $new]} {
set ext [file extension $name]
set associnfo [punk::auto_exec::shell_open_command $ext]
set valuetype [dict get $associnfo type]
set assoc [dict get $associnfo value]
set ftype [dict get $associnfo filetype]
set fullpath [file normalize $name]
#at least for .url files - long paths (paths with multiple spaces?) can fail to run. Using the short path seems to fix this.
#This seems hacky but anyway..
set attributes [file attributes $fullpath]
if {[dict exists $attributes -shortname]} {
set fullpath [dict get $attributes -shortname]
if {[string tolower $ext] eq ".lnk"} {
#for .lnk files we can often resolve the target path without needing to execute the shell open command
#- which is desirable because it allows us to avoid the absolute path requirement for unknown-handler auto_execok commands,
#which is desirable because it allows us to support relative paths and paths with environment variables in them
#(e.g for .lnk files that point to executables with environment variables in the path)
set targetinfo [punk::winlnk::resolve $name]
if {[dict exists $targetinfo link_roottarget]} {
set resolved [dict get $targetinfo link_roottarget]
#arguments?
} else {
puts "(unknown-handler): failed to resolve .lnk target for $name. Falling back to shell open command resolution, which may fail if absolute path is required."
}
} else {
#re-resolve.
set associnfo [punk::auto_exec::shell_open_command $ext]
set registry_valuetype [dict get $associnfo type] ;#sz vs expand_sz
set command_spec [dict get $associnfo value]
set windows_file_type [dict get $associnfo filetype]
if {[string match "*absolute_path required" $new]} {
puts "(unknown-handler): auto_execok for $name requires absolute path. Re-resolving $name with absolute path."
set fullpath [file normalize $name]
#at least for .url files - long paths (paths with multiple spaces?) can fail to run. Using the short path seems to fix this.
#This seems hacky but anyway..
set attributes [file attributes $fullpath]
if {[dict exists $attributes -shortname]} {
set fullpath [dict get $attributes -shortname]
}
set resolved [punk::auto_exec::shell_command_as_tcl_list -type $registry_valuetype $command_spec $fullpath]
} else {
#todo
set newnorm [file normalize $name]
puts stderr "(unknown-handler): re-resolving $name with auto_execok $newnorm"
set resolved [auto_execok $newnorm]
}
}
set new [punk::auto_exec::shell_command_as_tcl_list -type $valuetype $assoc $fullpath]
}
if {$resolved eq ""} {
#resolved may be emptyif auto_execok returns an empty string.
dict set ::tcl::UnknownOptions -code error
set ::tcl::UnknownResult "unresolved path '$name'"
#These aliases work fine for interactive use - but the result is always a string int-rep
#interp alias {} ~ {} file join $::env(HOME) ;#HOME must be capitalized to work cross platform (lowercase home works on windows - but probably not elsewhere)
if {$current_chunk ne "" || $current_chunk eq "" && [lindex $quoted end]} {
#we add the current chunk to the result list if it's not empty, or if it is empty but is quoted (because in that case we want to preserve it as an empty argument).
#we add the current chunk to the result list if it's not empty, or if it is empty but is quoted (because in that case we want to preserve it as an empty argument).
set files [glob -nocomplain -dir $folderpath -types f * .*]
}
set globs [list *]
} else {
if {![llength $types_entry] || "d" in $types_entry} {
#we need to check directories for hidden attribute - as on windows, not all dotfiles are hidden, and not all hidden files are dotfiles
set hdirs [glob -nocomplain -dir $folderpath -types {hidden d} $opt_glob]
set dirs [glob -nocomplain -dir $folderpath -types d $opt_glob]
}
if {![llength $types_entry] || "l" in $types_entry} {
set hlinks [glob -nocomplain -dir $folderpath -types {hidden l} $opt_glob]
set links [glob -nocomplain -dir $folderpath -types l $opt_glob] ;#links may have dupes - we don't care. punk::lib::struct_set_diff_unique
}
if {![llength $types_entry] || "f" in $types_entry} {
set hfiles [glob -nocomplain -dir $folderpath -types {hidden f} $opt_glob]
set files [glob -nocomplain -dir $folderpath -types f $opt_glob]
}
set globs [list $opt_glob]
}
#on windows this is a lot of separate globs to perform. Using the du_dirlisting_twapi is preferred for performance on windows - but this is a fallback and for testing.
#if {![llength $types_entry] || "d" in $types_entry} {}
if {!$skip_dirs} {
#we need to check directories for hidden attribute - as on windows, not all dotfiles are hidden, and not all hidden files are dotfiles
set hdirs [glob -nocomplain -dir $folderpath -types {hidden d} {*}$globs]
set dirs [glob -nocomplain -dir $folderpath -types d {*}$globs]
}
if {!$skip_links} {
set hlinks [glob -nocomplain -dir $folderpath -types {hidden l} {*}$globs]
set links [glob -nocomplain -dir $folderpath -types l {*}$globs] ;#links may have dupes - we don't care. punk::lib::struct_set_diff_unique
}
if {!$skip_files} {
set hfiles [glob -nocomplain -dir $folderpath -types {hidden f} {*}$globs]
set files [glob -nocomplain -dir $folderpath -types f {*}$globs]
}
} else {
if {$opt_glob eq "*"} {
#Note - glob operations seem to be faster than looped tests like 'file isdirectory' & 'file readlink'
#set parent [lindex $folders $folderidx]
#set dirs [glob -nocomplain -dir $folderpath -types d * .*]
#set links [glob -nocomplain -dir $folderpath -types l * .*] ;#links may have dupes - we don't care. punk::lib::struct_set_diff_unique
#set files [glob -nocomplain -dir $folderpath -types f * .*]
set globs [list * .*]
} else {
set globs [list $opt_glob]
#set dirs [glob -nocomplain -dir $folderpath -types d $opt_glob]
#set links [glob -nocomplain -dir $folderpath -types l $opt_glob] ;#links may have dupes - we don't care. punk::lib::struct_set_diff_unique
#set files [glob -nocomplain -dir $folderpath -types f $opt_glob]
}
if {![llength $types_entry] || "d" in $types_entry} {
#we need to classify our results - unlike a standard glob * operation which returns all entries in one collection.
#Note - glob operations seem to be faster than looped tests like 'file isdirectory' & 'file readlink'
#however - these are still significantly slower than a single glob with no restrictions - so we want to minimize the number of globs we do
#- but we also want to avoid doing extra work classifying entries that we will end up ignoring based on types/attributes/permissions filters.
if {!$skip_dirs} {
set dirs [glob -nocomplain -dir $folderpath -types d {*}$globs]
}
if {![llength $types_entry] || "l" in $types_entry} {
if {!$skip_links} {
set links [glob -nocomplain -dir $folderpath -types l {*}$globs] ;#links may have dupes - we don't care. punk::lib::struct_set_diff_unique
}
if {![llength $types_entry] || "f" in $types_entry} {
if {!$skip_files} {
set files [glob -nocomplain -dir $folderpath -types f {*}$globs]
}
@ -1957,6 +1974,7 @@ namespace eval punk::du {
set types_entry [list]
set types_attribute [list]
set types_permission [list]
set types_REQUIRED [list]
foreach t $entry_and_attribute_types {
switch -- $t {
f - d - l - p - s - b - c {
@ -2155,7 +2173,7 @@ namespace eval punk::du {
set errors [dict create]
if {"windows" eq $::tcl_platform(platform)} {
if {$opt_glob eq "*"} {
set globs [list * .*]
set globs [list *]
} else {
set globs [list $opt_glob]
}
@ -2295,6 +2313,13 @@ namespace eval punk::du {
#we don't classify anything as 'flaggedhidden' on unix.
#it is a convention for dotfiles rather than a flag - and we'll leave the distinction for the display library
set dirs {}
set hdirs {}
set files {}
set hfiles {}
set links {}
set hlinks {}
if {$opt_glob eq "*"} {
set globs [list * .*]
} else {
@ -2341,6 +2366,7 @@ namespace eval punk::du {
if {"$ft" in $meta_types} {
foreach path [set $lvar] {
if {$has_winpath && [punk::winpath::illegalname_test $path]} {
#review. we don't want to fix the path - we just want classify it as nonportable
set testpath [punk::winpath::illegalname_fix $path]
if {![catch {file stat $testpath arrstat} errM]} {
dict set meta_dict $path [dict create shorttype $ft {*}[array get arrstat]]
@ -2350,7 +2376,7 @@ namespace eval punk::du {
dict set meta_dict $path [dict create shorttype $ft {*}$empty_stat_dict]
}
} else {
#caller may have read perm on the containing folder - but not on child item - so file stat could raise an error
#caller may have permission to read on the containing folder - but not on child item - so file stat could raise an error
if {![catch {file stat $path arrstat} errM]} {
dict set meta_dict $path [dict create shorttype $ft {*}[array get arrstat]]
#It can be slightly expensive (for example involving network calls on windows domains)
variable user_home_cache
set user_home_cache ""
#tilde
#These aliases work fine for interactive use - but the result is always a string internal-rep
#interp alias {} ~ {} file join $::env(HOME) ;#HOME must be capitalized to work cross platform (lowercase home works on windows - but probably not elsewhere)
"Return user's home directory as the process sees it"\
-help\
"Return the user's home directory path as the process sees it.
(This is not always the same as ::env(HOME))
With additional arguments, return the path obtained by joining
the user's home directory with the supplied arguments.
usage e.g
cd [~]
(change to user's home)
.// [~] .config
(change to .config directory within the user's home
and list contents.)
equivalently:
gohome .config
(gohome uses the output of ~ to determine the home directory)
If the home directory cannot be determined due to the environment
in which the process is running, an error will be raised, as returning
an empty string is not a useful result and can cause issues if used as a path.
"
@opts
@values -min 0 -max -1
arg -type any -optional 1 -multiple 1
}
}
proc ~ {args} {
#review - HOME may be undefined or have been set to another value by other tools or the parent process.
#The process may even be running in a context where there is no home directory - e.g a container with no users, or a system service context.
#(we may be in a safe interp - which generally won't have env vars or filesystem access)
variable user_home_cache
if {$user_home_cache ne ""} {
set hdir $user_home_cache
#we still need to process args to join them to the home directory - but we can skip all the work of determining the home directory again.
} else {
set hdir ""
if {[catch {auto_execok whoami} whoami_exe]} {
set whoami_exe ""
}
if {$whoami_exe eq ""} {
#try env USER or USERNAME - these are commonly set to the username on many platforms - but may not be set in all contexts.
if {[info exists ::env(USER)]} {
set user $::env(USER)
} elseif {[info exists ::env(USERNAME)]} {
set user $::env(USERNAME)
} else {
set user ""
}
} else {
#set user [exec {*}$whoami_exe]
if {[catch {exec {*}$whoami_exe} user]} {
set user ""
}
}
if {[string trim $user] ne ""} {
#normalize user for use with 'file tildeexpand ~<user>'
#on windows, whoami may return DOMAIN\USER
#for tildeexpand to work, we need to convert this to USER@DOMAIN
if {"windows" eq $::tcl_platform(platform)} {
set parts [split $user "\\"]
#we expect only 1 or 2 parts
if {[llength $parts] == 2} {
lassign $parts domain username
#if we use username@domain format - we get the domain controller's view of our home directory - which can be different from the local machine's view of our home directory.
#e.g file tildeexpand ~jnoble@corp can return a local non existant path like c:/users/jnoble
#but it may be c:/users/jnoble.corp - or c:/users/something_else_entirely depending on how the local machine is configured.
#It may be that the domain controller is correct if it returns a network path like \\server\users\jnoble ??
#Network paths are not necessarily the preferred practive as of 2026 - but may still exist.
#Microsoft is encouraging the use of cloud systems - but it it unknown at this stage what sort of paths can be returned.
#REVIEW
set domainuser "$username@$domain"
#we can run file tildeexpand with username@domain and test if the path is writable
#this reduces the possibility that there happens to be a local user with the same name as the domain user - which would cause us to get the wrong home directory.
if {![catch {file tildeexpand ~$domainuser} path]} {
if {[file writable $path]} {
set user $domainuser
set hdir $path ;#set hdir so we don't re-lookup below.
}
}
if {$hdir eq ""} {
#for now we will use the unqualified username.
set user $username
}
} elseif {[llength $parts] == 1} {
set user [lindex $parts 0]
} else {
#unexpected format - emit warning
puts stderr "Warning: Unexpected format of username '$user' returned by whoami. Expected format 'DOMAIN\\USER' or 'USER'. Unable to determine home directory for this user."
set user ""
}
}
#only enter this branch if hdir wasn't resolved above for windows domain user.
if {$hdir eq "" && $user ne ""} {
#we use file tildeexpand ~user because the intention is stated in the tcl source as:
#* the intent is to retrieve (as on Unix) the system's view
#* of the home irrespective of environment settings of HOME
#* and USERPROFILE.
# - this aligns with our intention here.
if {![catch {file tildeexpand ~$user} path]} {
set hdir [punk::valcopy $path]
} else {
#tcl <= 8.6 may not have file tildeexpand.
#we now have no option but to rely on environment variables - which may not be set or may be set to an incorrect value
#as tcl <= 8.6 needs to be supported - but isn't the primary target we will allow this fallback - but raise a warning as this is not ideal.
puts stderr "punk::nav::fs::~ Warning: Unable to determine home directory for user '$user' using 'file tildeexpand ~$user'. Falling back to environment variables, which may not be set or may be incorrect. Consider upgrading to Tcl 9.0 or later for improved reliability."
if {"windows" eq $::tcl_platform(platform)} {
if {[info exists ::env(USERPROFILE)]} {
set hdir [punk::valcopy $::env(USERPROFILE)]
} else {
set hdir ""
}
} else {
if {[info exists ::env(HOME)]} {
set hdir [punk::valcopy $::env(HOME)]
} else {
set hdir ""
}
}
}
}
}
}
if {$hdir eq ""} {
error "punk::nav::fs::~ Unable to determine home directory for user '$user'. Consider upgrading to Tcl 9.0 or later for improved reliability in home directory detection."
}
file pathtype $hdir ;#flips internal-rep to path
if {![file isdirectory $hdir]} {
#file isdirectory should also return true if the path exists and is a symlink to a directory - but if it doesn't exist at all - or is a file - then we have a problem.
error "punk::nav::fs::~ Determined home directory path '$hdir' does not exist (or is not a directory)."
} else {
if {![file readable $hdir]} {
error "punk::nav::fs::~ Determined home directory path '$hdir' is not readable."
}
}
set user_home_cache $hdir ;#cache only the home directory.
set d $hdir
#use the file join 2-arg optimisation to avoid losing path-rep - probably doesn't give any advantage on all Tcl versions
#review - for what versions does/did the 2-arg version of file join not just return a string?
error "punk::nav::fs::d/new $error_string\n$num_created directories out of [llength $fullpath_list] were created successfully before the error was encountered."
error "punk::nav::fs::newdir $error_string\n$num_created directories out of [llength $fullpath_list] were created successfully before the error was encountered."
}
#display summaries of created directories (which may have already existed) by reusing d/ to get info on them.
set query_paths [lmap v $paths {string cat $v "/*"}]
#no link_target - probably an ordinary file - but there could have been some other error in reading the binary windows lnk format.
#no link_roottarget - probably an ordinary file - but there could have been some other error in reading the binary windows lnk format.
set is_valid_lnk 0
}
if {$is_valid_lnk} {
switch -- $target_type {
file {
set display [dict get $fdict display]
set display "$fshortcut_style$display (shortcut $tgt)" ;#
if {[dict exists $shortcutinfo stringdata command_line_arguments]} {
set display "$fshortcut_style$display (shortcut to $root_tgt [dict get $shortcutinfo stringdata command_line_arguments])"
} else {
set display "$fshortcut_style$display (shortcut $root_tgt)" ;#
}
dict set fdict display $display
lappend finfo_plus $fdict
}
directory {
#target of link is a dir - for display/categorisation purposes we want to see it as a dir
#will be styled later based on membership of dir_shortcuts
#review: we shouldn't see a link to a dir that also has command_line_arguments
#- but if we do, we will just ignore the command_line_arguments for now and treat as a directory shortcut.
lappend dirs $fname
lappend dir_shortcuts $fname
}
}
} else {
#we were unable to get link_target - but we still need to check if it failed the header check (then assume not intended to be a windows shell lnk) or for some other reason.
#we were unable to get link_roottarget - but we still need to check if it failed the header check (then assume not intended to be a windows shell lnk) or for some other reason.
if {[dict exists $shortcutinfo error]} {
if {[dict get $shortcutinfo error] ne "lnk_header_check_failed"} {
#Presumably there is a valid lnk header, but some unexpected error occurred - show it in the display for the file
set linkinfocontent [dict get $linkinfo_content_dict content]
set next_start [dict get $linkinfo_content_dict next_start] ;#location of section following LinkInfo (Location information) - this will be the Data Strings.
set link_target ""
set link_roottarget ""
set linkfields [dict create]
if {$linkinfocontent ne ""} {
set linkfields [LinkInfo_get_fields $linkinfocontent]
set localbase_path [dict get $linkfields localbasepath]
set suffix_path [dict get $linkfields commonpathsuffix]
if {"windows" eq $::tcl_platform(platform)} {
set link_target [file join $localbase_path $suffix_path]
set link_roottarget [file join $localbase_path $suffix_path]
} else {
#review - calling mount and parsing its output every time we parse a .lnk file makes this slow on large folders with .lnk files
# - we may want to cache the results of mount for some period of time or until we detect a change in the system's mounts (e.g. by monitoring /proc/mounts for changes or using a filesystem watcher on /mnt)
if {[regexp {([a-zA-Z]):\\(.*)} $localbase_path _match drive_letter tail]} {
set localbase_path [string map {\\ /} $localbase_path]
set tail [string trimleft [string map {\\ /} $tail] /]
set link_target ""
set link_roottarget ""
#shortcut basepath is a windows path with drive letter - try to resolve it on unix by looking for a corresponding mount from fstab or a point under /mnt
set mountinfo [exec mount]
foreach line [split $mountinfo "\n"] {
#review - a more specific mount target might exist that includes the drive letter as part of the mount point name and is a longer prefix of the localbase_path
#- we should probably look for the longest prefix match rather than just the drive letter
set link_target [file join $mount_point $tail $suffix_path]
set link_roottarget [file join $mount_point $tail $suffix_path]
break
}
}
if {$link_target eq ""} {
if {$link_roottarget eq ""} {
#review - under what circumstances could this happen? If the drive letter doesn't match any mount points, then /mnt/drive_letter should generally already have been found above above
# - However, it may be possible for /mnt/drive_Letter to still exist even if it's not reflected in the output of mount or the output of mount is in an unexpected format.
#nothing in mount result matches the drive letter - try looking for a mount point under /mnt with the drive letter as the name
if {[file exists /mnt/$drive_letter]} {
set link_target [file join /mnt/$drive_letter $tail $suffix_path]
set link_roottarget [file join /mnt/$drive_letter $tail $suffix_path]
} else {
if {$drive_letter eq [string tolower $drive_letter]} {
set op_drive_letter [string toupper $drive_letter]
set op_drive_letter [string tolower $drive_letter]
}
if {[file exists /mnt/$op_drive_letter]} {
set link_target [file join /mnt/$op_drive_letter $tail $suffix_path]
set link_roottarget [file join /mnt/$op_drive_letter $tail $suffix_path]
} else {
#leave as is except for backslashes converted to forward
#- probably won't resolve correctly unless the unix system has a folder named drive_letter: in the current folder with a copy of the original filestructure.
set link_target [file join $localbase_path $suffix_path]
set link_roottarget [file join $localbase_path $suffix_path]
}
}
} else {
#shortcut basepath is a windows path with drive letter and we found a matching mount point - link_target is set to the resolved path
#shortcut basepath is a windows path with drive letter and we found a matching mount point - link_roottarget is set to the resolved path
}
} else {
#shortcut basepath doesn't match expected windows path format - just join it with the suffix and hope for the best
#could be something like a network path or it could be something else entirely
set link_target [file join $localbase_path $suffix_path]
set link_roottarget [file join $localbase_path $suffix_path]
#determine type based on info in the .lnk file, such as file attributes and link flags
#determine target file/directory/link type based on info in the .lnk file, such as file attributes and link flags
#review - a .lnk may target an executable with arguments.
#In this case, the target type may be considered a file (the executable) but it may also be useful to indicate that it's a link to an executable with arguments(?).
if {"DIRECTORY" in $file_attributes} {
return [dict create type directory mechanism file_attributes]"
set command [uplevel 1 [list namespace which $command]]
if {$command eq ""} {
#review
puts stderr "commandstack::rename_command no rename performed for command '$command' by '$renamer'. command '$command' not found in calling context. Ensure command name is fully qualified or that command exists."
#add something to stack?
return [dict create implementation ""]
}
set mungedcommand [string map {:: _ns_} $command]
set mungedrenamer [string map {:: _ns_} $renamer]
variable all_stacks
@ -284,7 +290,8 @@ namespace eval commandstack {
]
if {![dict get $nextinfo do_rename]} {
#review
puts stderr "no rename performed"
puts stderr "commandstack::rename_command no rename performed for command '$command' by '$renamer'"
#don't cache negative result for any relative paths - as they may become valid if the file appears in the relative location, or if the user changes directory and the same relative path points to a different file.
#our only way to do this is by cooperating with the unknown handler.
set auto_execs($name) "for_unknown_handler by punk::auto_exec relative_path - file existence should be re-checked at call time"
return $auto_execs($name)
}
if {[string tolower [file extension $name]] eq ".lnk"} {
#special case .lnk
#todo - consider working directory or other properties of link before launching?
@ -246,11 +249,11 @@ namespace eval punk {
set associnfo [punk::auto_exec::shell_open_command $test_ext]
set valuetype [dict get $associnfo type]
set assoc [dict get $associnfo value]
set ftype [dict get $associnfo filetype]
set windows_file_type [dict get $associnfo filetype]
set run [punk::auto_exec::shell_command_as_tcl_list -type $valuetype $assoc $file] ;# -workingdir [pwd] vs path of script?
@ -269,6 +272,8 @@ namespace eval punk {
}
}
}
#cache negative result for absolute paths - as they will always point to the same location, so if they don't exist now, they won't exist later.
set auto_execs($name) ""
return ""
}
@ -559,7 +564,7 @@ if {![llength [info commands ::ansistring]]} {
package require punk::repl::codethread
package require punk::config
#package require textblock
package require punk::console ;#requires Thread
catch {package require punk::console} ;#requires Thread - will not work in safe interps.
package require punk::ns
package require punk::winpath ;# for windows paths - but has functions that can be called on unix systems
package require punk::repo
@ -5396,27 +5401,54 @@ namespace eval punk {
} else {
set repl_runid [punk::get_repl_runid]
#set ::punk::last_run_display [list]
if {$new eq "(resolve_in_unknown_handler) punk::auto_exec absolute_path required"} {
#re-resolve.
puts "(unknown-handler): auto_execok for $name requires absolute path. Re-resolving $name with absolute path."
set resolved $new
if {[string match "for_unknown_handler *" $new]} {
set ext [file extension $name]
set associnfo [punk::auto_exec::shell_open_command $ext]
set valuetype [dict get $associnfo type]
set assoc [dict get $associnfo value]
set ftype [dict get $associnfo filetype]
set fullpath [file normalize $name]
#at least for .url files - long paths (paths with multiple spaces?) can fail to run. Using the short path seems to fix this.
#This seems hacky but anyway..
set attributes [file attributes $fullpath]
if {[dict exists $attributes -shortname]} {
set fullpath [dict get $attributes -shortname]
if {[string tolower $ext] eq ".lnk"} {
#for .lnk files we can often resolve the target path without needing to execute the shell open command
#- which is desirable because it allows us to avoid the absolute path requirement for unknown-handler auto_execok commands,
#which is desirable because it allows us to support relative paths and paths with environment variables in them
#(e.g for .lnk files that point to executables with environment variables in the path)
set targetinfo [punk::winlnk::resolve $name]
if {[dict exists $targetinfo link_roottarget]} {
set resolved [dict get $targetinfo link_roottarget]
#arguments?
} else {
puts "(unknown-handler): failed to resolve .lnk target for $name. Falling back to shell open command resolution, which may fail if absolute path is required."
}
} else {
#re-resolve.
set associnfo [punk::auto_exec::shell_open_command $ext]
set registry_valuetype [dict get $associnfo type] ;#sz vs expand_sz
set command_spec [dict get $associnfo value]
set windows_file_type [dict get $associnfo filetype]
if {[string match "*absolute_path required" $new]} {
puts "(unknown-handler): auto_execok for $name requires absolute path. Re-resolving $name with absolute path."
set fullpath [file normalize $name]
#at least for .url files - long paths (paths with multiple spaces?) can fail to run. Using the short path seems to fix this.
#This seems hacky but anyway..
set attributes [file attributes $fullpath]
if {[dict exists $attributes -shortname]} {
set fullpath [dict get $attributes -shortname]
}
set resolved [punk::auto_exec::shell_command_as_tcl_list -type $registry_valuetype $command_spec $fullpath]
} else {
#todo
set newnorm [file normalize $name]
puts stderr "(unknown-handler): re-resolving $name with auto_execok $newnorm"
set resolved [auto_execok $newnorm]
}
}
set new [punk::auto_exec::shell_command_as_tcl_list -type $valuetype $assoc $fullpath]
}
if {$resolved eq ""} {
#resolved may be emptyif auto_execok returns an empty string.
dict set ::tcl::UnknownOptions -code error
set ::tcl::UnknownResult "unresolved path '$name'"
#These aliases work fine for interactive use - but the result is always a string int-rep
#interp alias {} ~ {} file join $::env(HOME) ;#HOME must be capitalized to work cross platform (lowercase home works on windows - but probably not elsewhere)
if {$current_chunk ne "" || $current_chunk eq "" && [lindex $quoted end]} {
#we add the current chunk to the result list if it's not empty, or if it is empty but is quoted (because in that case we want to preserve it as an empty argument).
#we add the current chunk to the result list if it's not empty, or if it is empty but is quoted (because in that case we want to preserve it as an empty argument).
set files [glob -nocomplain -dir $folderpath -types f * .*]
}
set globs [list *]
} else {
if {![llength $types_entry] || "d" in $types_entry} {
#we need to check directories for hidden attribute - as on windows, not all dotfiles are hidden, and not all hidden files are dotfiles
set hdirs [glob -nocomplain -dir $folderpath -types {hidden d} $opt_glob]
set dirs [glob -nocomplain -dir $folderpath -types d $opt_glob]
}
if {![llength $types_entry] || "l" in $types_entry} {
set hlinks [glob -nocomplain -dir $folderpath -types {hidden l} $opt_glob]
set links [glob -nocomplain -dir $folderpath -types l $opt_glob] ;#links may have dupes - we don't care. punk::lib::struct_set_diff_unique
}
if {![llength $types_entry] || "f" in $types_entry} {
set hfiles [glob -nocomplain -dir $folderpath -types {hidden f} $opt_glob]
set files [glob -nocomplain -dir $folderpath -types f $opt_glob]
}
set globs [list $opt_glob]
}
#on windows this is a lot of separate globs to perform. Using the du_dirlisting_twapi is preferred for performance on windows - but this is a fallback and for testing.
#if {![llength $types_entry] || "d" in $types_entry} {}
if {!$skip_dirs} {
#we need to check directories for hidden attribute - as on windows, not all dotfiles are hidden, and not all hidden files are dotfiles
set hdirs [glob -nocomplain -dir $folderpath -types {hidden d} {*}$globs]
set dirs [glob -nocomplain -dir $folderpath -types d {*}$globs]
}
if {!$skip_links} {
set hlinks [glob -nocomplain -dir $folderpath -types {hidden l} {*}$globs]
set links [glob -nocomplain -dir $folderpath -types l {*}$globs] ;#links may have dupes - we don't care. punk::lib::struct_set_diff_unique
}
if {!$skip_files} {
set hfiles [glob -nocomplain -dir $folderpath -types {hidden f} {*}$globs]
set files [glob -nocomplain -dir $folderpath -types f {*}$globs]
}
} else {
if {$opt_glob eq "*"} {
#Note - glob operations seem to be faster than looped tests like 'file isdirectory' & 'file readlink'
#set parent [lindex $folders $folderidx]
#set dirs [glob -nocomplain -dir $folderpath -types d * .*]
#set links [glob -nocomplain -dir $folderpath -types l * .*] ;#links may have dupes - we don't care. punk::lib::struct_set_diff_unique
#set files [glob -nocomplain -dir $folderpath -types f * .*]
set globs [list * .*]
} else {
set globs [list $opt_glob]
#set dirs [glob -nocomplain -dir $folderpath -types d $opt_glob]
#set links [glob -nocomplain -dir $folderpath -types l $opt_glob] ;#links may have dupes - we don't care. punk::lib::struct_set_diff_unique
#set files [glob -nocomplain -dir $folderpath -types f $opt_glob]
}
if {![llength $types_entry] || "d" in $types_entry} {
#we need to classify our results - unlike a standard glob * operation which returns all entries in one collection.
#Note - glob operations seem to be faster than looped tests like 'file isdirectory' & 'file readlink'
#however - these are still significantly slower than a single glob with no restrictions - so we want to minimize the number of globs we do
#- but we also want to avoid doing extra work classifying entries that we will end up ignoring based on types/attributes/permissions filters.
if {!$skip_dirs} {
set dirs [glob -nocomplain -dir $folderpath -types d {*}$globs]
}
if {![llength $types_entry] || "l" in $types_entry} {
if {!$skip_links} {
set links [glob -nocomplain -dir $folderpath -types l {*}$globs] ;#links may have dupes - we don't care. punk::lib::struct_set_diff_unique
}
if {![llength $types_entry] || "f" in $types_entry} {
if {!$skip_files} {
set files [glob -nocomplain -dir $folderpath -types f {*}$globs]
}
@ -1957,6 +1974,7 @@ namespace eval punk::du {
set types_entry [list]
set types_attribute [list]
set types_permission [list]
set types_REQUIRED [list]
foreach t $entry_and_attribute_types {
switch -- $t {
f - d - l - p - s - b - c {
@ -2155,7 +2173,7 @@ namespace eval punk::du {
set errors [dict create]
if {"windows" eq $::tcl_platform(platform)} {
if {$opt_glob eq "*"} {
set globs [list * .*]
set globs [list *]
} else {
set globs [list $opt_glob]
}
@ -2295,6 +2313,13 @@ namespace eval punk::du {
#we don't classify anything as 'flaggedhidden' on unix.
#it is a convention for dotfiles rather than a flag - and we'll leave the distinction for the display library
set dirs {}
set hdirs {}
set files {}
set hfiles {}
set links {}
set hlinks {}
if {$opt_glob eq "*"} {
set globs [list * .*]
} else {
@ -2341,6 +2366,7 @@ namespace eval punk::du {
if {"$ft" in $meta_types} {
foreach path [set $lvar] {
if {$has_winpath && [punk::winpath::illegalname_test $path]} {
#review. we don't want to fix the path - we just want classify it as nonportable
set testpath [punk::winpath::illegalname_fix $path]
if {![catch {file stat $testpath arrstat} errM]} {
dict set meta_dict $path [dict create shorttype $ft {*}[array get arrstat]]
@ -2350,7 +2376,7 @@ namespace eval punk::du {
dict set meta_dict $path [dict create shorttype $ft {*}$empty_stat_dict]
}
} else {
#caller may have read perm on the containing folder - but not on child item - so file stat could raise an error
#caller may have permission to read on the containing folder - but not on child item - so file stat could raise an error
if {![catch {file stat $path arrstat} errM]} {
dict set meta_dict $path [dict create shorttype $ft {*}[array get arrstat]]
#It can be slightly expensive (for example involving network calls on windows domains)
variable user_home_cache
set user_home_cache ""
#tilde
#These aliases work fine for interactive use - but the result is always a string internal-rep
#interp alias {} ~ {} file join $::env(HOME) ;#HOME must be capitalized to work cross platform (lowercase home works on windows - but probably not elsewhere)
"Return user's home directory as the process sees it"\
-help\
"Return the user's home directory path as the process sees it.
(This is not always the same as ::env(HOME))
With additional arguments, return the path obtained by joining
the user's home directory with the supplied arguments.
usage e.g
cd [~]
(change to user's home)
.// [~] .config
(change to .config directory within the user's home
and list contents.)
equivalently:
gohome .config
(gohome uses the output of ~ to determine the home directory)
If the home directory cannot be determined due to the environment
in which the process is running, an error will be raised, as returning
an empty string is not a useful result and can cause issues if used as a path.
"
@opts
@values -min 0 -max -1
arg -type any -optional 1 -multiple 1
}
}
proc ~ {args} {
#review - HOME may be undefined or have been set to another value by other tools or the parent process.
#The process may even be running in a context where there is no home directory - e.g a container with no users, or a system service context.
#(we may be in a safe interp - which generally won't have env vars or filesystem access)
variable user_home_cache
if {$user_home_cache ne ""} {
set hdir $user_home_cache
#we still need to process args to join them to the home directory - but we can skip all the work of determining the home directory again.
} else {
set hdir ""
if {[catch {auto_execok whoami} whoami_exe]} {
set whoami_exe ""
}
if {$whoami_exe eq ""} {
#try env USER or USERNAME - these are commonly set to the username on many platforms - but may not be set in all contexts.
if {[info exists ::env(USER)]} {
set user $::env(USER)
} elseif {[info exists ::env(USERNAME)]} {
set user $::env(USERNAME)
} else {
set user ""
}
} else {
#set user [exec {*}$whoami_exe]
if {[catch {exec {*}$whoami_exe} user]} {
set user ""
}
}
if {[string trim $user] ne ""} {
#normalize user for use with 'file tildeexpand ~<user>'
#on windows, whoami may return DOMAIN\USER
#for tildeexpand to work, we need to convert this to USER@DOMAIN
if {"windows" eq $::tcl_platform(platform)} {
set parts [split $user "\\"]
#we expect only 1 or 2 parts
if {[llength $parts] == 2} {
lassign $parts domain username
#if we use username@domain format - we get the domain controller's view of our home directory - which can be different from the local machine's view of our home directory.
#e.g file tildeexpand ~jnoble@corp can return a local non existant path like c:/users/jnoble
#but it may be c:/users/jnoble.corp - or c:/users/something_else_entirely depending on how the local machine is configured.
#It may be that the domain controller is correct if it returns a network path like \\server\users\jnoble ??
#Network paths are not necessarily the preferred practive as of 2026 - but may still exist.
#Microsoft is encouraging the use of cloud systems - but it it unknown at this stage what sort of paths can be returned.
#REVIEW
set domainuser "$username@$domain"
#we can run file tildeexpand with username@domain and test if the path is writable
#this reduces the possibility that there happens to be a local user with the same name as the domain user - which would cause us to get the wrong home directory.
if {![catch {file tildeexpand ~$domainuser} path]} {
if {[file writable $path]} {
set user $domainuser
set hdir $path ;#set hdir so we don't re-lookup below.
}
}
if {$hdir eq ""} {
#for now we will use the unqualified username.
set user $username
}
} elseif {[llength $parts] == 1} {
set user [lindex $parts 0]
} else {
#unexpected format - emit warning
puts stderr "Warning: Unexpected format of username '$user' returned by whoami. Expected format 'DOMAIN\\USER' or 'USER'. Unable to determine home directory for this user."
set user ""
}
}
#only enter this branch if hdir wasn't resolved above for windows domain user.
if {$hdir eq "" && $user ne ""} {
#we use file tildeexpand ~user because the intention is stated in the tcl source as:
#* the intent is to retrieve (as on Unix) the system's view
#* of the home irrespective of environment settings of HOME
#* and USERPROFILE.
# - this aligns with our intention here.
if {![catch {file tildeexpand ~$user} path]} {
set hdir [punk::valcopy $path]
} else {
#tcl <= 8.6 may not have file tildeexpand.
#we now have no option but to rely on environment variables - which may not be set or may be set to an incorrect value
#as tcl <= 8.6 needs to be supported - but isn't the primary target we will allow this fallback - but raise a warning as this is not ideal.
puts stderr "punk::nav::fs::~ Warning: Unable to determine home directory for user '$user' using 'file tildeexpand ~$user'. Falling back to environment variables, which may not be set or may be incorrect. Consider upgrading to Tcl 9.0 or later for improved reliability."
if {"windows" eq $::tcl_platform(platform)} {
if {[info exists ::env(USERPROFILE)]} {
set hdir [punk::valcopy $::env(USERPROFILE)]
} else {
set hdir ""
}
} else {
if {[info exists ::env(HOME)]} {
set hdir [punk::valcopy $::env(HOME)]
} else {
set hdir ""
}
}
}
}
}
}
if {$hdir eq ""} {
error "punk::nav::fs::~ Unable to determine home directory for user '$user'. Consider upgrading to Tcl 9.0 or later for improved reliability in home directory detection."
}
file pathtype $hdir ;#flips internal-rep to path
if {![file isdirectory $hdir]} {
#file isdirectory should also return true if the path exists and is a symlink to a directory - but if it doesn't exist at all - or is a file - then we have a problem.
error "punk::nav::fs::~ Determined home directory path '$hdir' does not exist (or is not a directory)."
} else {
if {![file readable $hdir]} {
error "punk::nav::fs::~ Determined home directory path '$hdir' is not readable."
}
}
set user_home_cache $hdir ;#cache only the home directory.
set d $hdir
#use the file join 2-arg optimisation to avoid losing path-rep - probably doesn't give any advantage on all Tcl versions
#review - for what versions does/did the 2-arg version of file join not just return a string?
error "punk::nav::fs::d/new $error_string\n$num_created directories out of [llength $fullpath_list] were created successfully before the error was encountered."
error "punk::nav::fs::newdir $error_string\n$num_created directories out of [llength $fullpath_list] were created successfully before the error was encountered."
}
#display summaries of created directories (which may have already existed) by reusing d/ to get info on them.
set query_paths [lmap v $paths {string cat $v "/*"}]
#no link_target - probably an ordinary file - but there could have been some other error in reading the binary windows lnk format.
#no link_roottarget - probably an ordinary file - but there could have been some other error in reading the binary windows lnk format.
set is_valid_lnk 0
}
if {$is_valid_lnk} {
switch -- $target_type {
file {
set display [dict get $fdict display]
set display "$fshortcut_style$display (shortcut $tgt)" ;#
if {[dict exists $shortcutinfo stringdata command_line_arguments]} {
set display "$fshortcut_style$display (shortcut to $root_tgt [dict get $shortcutinfo stringdata command_line_arguments])"
} else {
set display "$fshortcut_style$display (shortcut $root_tgt)" ;#
}
dict set fdict display $display
lappend finfo_plus $fdict
}
directory {
#target of link is a dir - for display/categorisation purposes we want to see it as a dir
#will be styled later based on membership of dir_shortcuts
#review: we shouldn't see a link to a dir that also has command_line_arguments
#- but if we do, we will just ignore the command_line_arguments for now and treat as a directory shortcut.
lappend dirs $fname
lappend dir_shortcuts $fname
}
}
} else {
#we were unable to get link_target - but we still need to check if it failed the header check (then assume not intended to be a windows shell lnk) or for some other reason.
#we were unable to get link_roottarget - but we still need to check if it failed the header check (then assume not intended to be a windows shell lnk) or for some other reason.
if {[dict exists $shortcutinfo error]} {
if {[dict get $shortcutinfo error] ne "lnk_header_check_failed"} {
#Presumably there is a valid lnk header, but some unexpected error occurred - show it in the display for the file
set linkinfocontent [dict get $linkinfo_content_dict content]
set next_start [dict get $linkinfo_content_dict next_start] ;#location of section following LinkInfo (Location information) - this will be the Data Strings.
set link_target ""
set link_roottarget ""
set linkfields [dict create]
if {$linkinfocontent ne ""} {
set linkfields [LinkInfo_get_fields $linkinfocontent]
set localbase_path [dict get $linkfields localbasepath]
set suffix_path [dict get $linkfields commonpathsuffix]
if {"windows" eq $::tcl_platform(platform)} {
set link_target [file join $localbase_path $suffix_path]
set link_roottarget [file join $localbase_path $suffix_path]
} else {
#review - calling mount and parsing its output every time we parse a .lnk file makes this slow on large folders with .lnk files
# - we may want to cache the results of mount for some period of time or until we detect a change in the system's mounts (e.g. by monitoring /proc/mounts for changes or using a filesystem watcher on /mnt)
if {[regexp {([a-zA-Z]):\\(.*)} $localbase_path _match drive_letter tail]} {
set localbase_path [string map {\\ /} $localbase_path]
set tail [string trimleft [string map {\\ /} $tail] /]
set link_target ""
set link_roottarget ""
#shortcut basepath is a windows path with drive letter - try to resolve it on unix by looking for a corresponding mount from fstab or a point under /mnt
set mountinfo [exec mount]
foreach line [split $mountinfo "\n"] {
#review - a more specific mount target might exist that includes the drive letter as part of the mount point name and is a longer prefix of the localbase_path
#- we should probably look for the longest prefix match rather than just the drive letter
set link_target [file join $mount_point $tail $suffix_path]
set link_roottarget [file join $mount_point $tail $suffix_path]
break
}
}
if {$link_target eq ""} {
if {$link_roottarget eq ""} {
#review - under what circumstances could this happen? If the drive letter doesn't match any mount points, then /mnt/drive_letter should generally already have been found above above
# - However, it may be possible for /mnt/drive_Letter to still exist even if it's not reflected in the output of mount or the output of mount is in an unexpected format.
#nothing in mount result matches the drive letter - try looking for a mount point under /mnt with the drive letter as the name
if {[file exists /mnt/$drive_letter]} {
set link_target [file join /mnt/$drive_letter $tail $suffix_path]
set link_roottarget [file join /mnt/$drive_letter $tail $suffix_path]
} else {
if {$drive_letter eq [string tolower $drive_letter]} {
set op_drive_letter [string toupper $drive_letter]
set op_drive_letter [string tolower $drive_letter]
}
if {[file exists /mnt/$op_drive_letter]} {
set link_target [file join /mnt/$op_drive_letter $tail $suffix_path]
set link_roottarget [file join /mnt/$op_drive_letter $tail $suffix_path]
} else {
#leave as is except for backslashes converted to forward
#- probably won't resolve correctly unless the unix system has a folder named drive_letter: in the current folder with a copy of the original filestructure.
set link_target [file join $localbase_path $suffix_path]
set link_roottarget [file join $localbase_path $suffix_path]
}
}
} else {
#shortcut basepath is a windows path with drive letter and we found a matching mount point - link_target is set to the resolved path
#shortcut basepath is a windows path with drive letter and we found a matching mount point - link_roottarget is set to the resolved path
}
} else {
#shortcut basepath doesn't match expected windows path format - just join it with the suffix and hope for the best
#could be something like a network path or it could be something else entirely
set link_target [file join $localbase_path $suffix_path]
set link_roottarget [file join $localbase_path $suffix_path]
#determine type based on info in the .lnk file, such as file attributes and link flags
#determine target file/directory/link type based on info in the .lnk file, such as file attributes and link flags
#review - a .lnk may target an executable with arguments.
#In this case, the target type may be considered a file (the executable) but it may also be useful to indicate that it's a link to an executable with arguments(?).
if {"DIRECTORY" in $file_attributes} {
return [dict create type directory mechanism file_attributes]"
