Browse Source

fix ::env(SHELL) more posixy,mintty fixes,fglob -patterndebug,dirfiles_dict collection changes for links,remove punk::args stderr debug output

master
Julian Noble 3 months ago
parent
commit
413d25c065
  1. 2
      src/bootsupport/modules/punk/args-0.2.1.tm
  2. 123
      src/bootsupport/modules/punk/console-0.1.1.tm
  3. 81
      src/bootsupport/modules/punk/du-0.1.0.tm
  4. 7
      src/bootsupport/modules/punk/lib-0.1.6.tm
  5. 110
      src/bootsupport/modules/punk/nav/fs-0.1.0.tm
  6. 23
      src/bootsupport/modules/punk/repl-0.1.2.tm
  7. 4
      src/bootsupport/modules/punk/winlnk-0.1.1.tm
  8. 2
      src/modules/punk/args-999999.0a1.0.tm
  9. 123
      src/modules/punk/console-999999.0a1.0.tm
  10. 81
      src/modules/punk/du-999999.0a1.0.tm
  11. 7
      src/modules/punk/lib-999999.0a1.0.tm
  12. 110
      src/modules/punk/nav/fs-999999.0a1.0.tm
  13. 23
      src/modules/punk/repl-999999.0a1.0.tm
  14. 2
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.2.1.tm
  15. 123
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.1.1.tm
  16. 81
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/du-0.1.0.tm
  17. 7
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/lib-0.1.6.tm
  18. 110
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm
  19. 23
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl-0.1.2.tm
  20. 4
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/winlnk-0.1.1.tm
  21. 2
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.2.1.tm
  22. 123
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.1.1.tm
  23. 81
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/du-0.1.0.tm
  24. 7
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/lib-0.1.6.tm
  25. 110
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm
  26. 23
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl-0.1.2.tm
  27. 4
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/winlnk-0.1.1.tm
  28. 2
      src/vfs/_vfscommon.vfs/modules/punk/args-0.2.1.tm
  29. 123
      src/vfs/_vfscommon.vfs/modules/punk/console-0.1.1.tm
  30. 81
      src/vfs/_vfscommon.vfs/modules/punk/du-0.1.0.tm
  31. 7
      src/vfs/_vfscommon.vfs/modules/punk/lib-0.1.6.tm
  32. 110
      src/vfs/_vfscommon.vfs/modules/punk/nav/fs-0.1.0.tm
  33. 23
      src/vfs/_vfscommon.vfs/modules/punk/repl-0.1.2.tm
  34. 4
      src/vfs/_vfscommon.vfs/modules/punk/winlnk-0.1.1.tm

2
src/bootsupport/modules/punk/args-0.2.1.tm

@ -9387,7 +9387,6 @@ tcl::namespace::eval punk::args {
set chosen $bestmatch
set choice_in_list 1
}
puts ">>>>> chosen: $chosen bestmatch: $bestmatch for c_check: $c_check choices_test: $choices_test allchoices: $allchoices"
} else {
set chosen [tcl::prefix::match -error "" [list {*}[lsort -unique $allchoices] {*}$choiceprefixreservelist] $c_check]
if {$chosen eq "" || $chosen in $choiceprefixreservelist} {
@ -9413,7 +9412,6 @@ tcl::namespace::eval punk::args {
if {$choicemultiple_max != -1 && $choicemultiple_max < 2} {
#single choice allowed per clause-member
if {$is_multiple} {
puts ">>>>> existing:'$existing' element_index:$element_index choice_index:$choice_idx chosen: $chosen"
if {$clause_size == 1} {
#no list wrapping of single element in $dname dict - so don't index into it with element_index
#lset existing $element_index $chosen ;#wrong - test::punk::args test: choice_multiple_with_choiceprefix.

123
src/bootsupport/modules/punk/console-0.1.1.tm

@ -87,6 +87,8 @@ namespace eval punk::console {
#Note that windows terminal cooked mode seems to use 8 for interactive use even if set differently
#e.g typing tab characters may still be echoed 8-spaced while writing to stdout my obey the terminal's tab stops.
variable has_twapi 0
variable previous_stty_state_stdin ""
variable previous_stty_state_stdout ""
variable previous_stty_state_stderr ""
@ -565,7 +567,128 @@ namespace eval punk::console {
return done
}
}
namespace eval system {
proc enableRaw_unix {{channel stdin}} {
upvar ::punk::console::previous_stty_state_$channel previous_stty_state_$channel
set sttycmd [auto_execok stty]
if {[set previous_stty_state_$channel] eq ""} {
if {[catch {exec {*}$sttycmd -g <@$channel} previous_stty_state_$channel]} {
set previous_stty_state_$channel ""
}
}
#REVIEW
switch $channel {
stdin {
exec {*}$sttycmd -icanon -echo -isig
}
default {
exec {*}$sttycmd raw -echo <@$channel
}
}
catch {
tsv::set console is_raw 1
}
return [dict create previous [set previous_stty_state_$channel]]
}
proc disableRaw_unix {{channel stdin}} {
upvar ::punk::console::previous_stty_state_$channel previous_stty_state_$channel
set sttycmd [auto_execok stty]
if {[set previous_stty_state_$channel] ne ""} {
exec {*}$sttycmd [set previous_stty_state_$channel]
set previous_stty_state_$channel ""
} else {
#REVIEW
switch $channel {
stdin {
exec {*}$sttycmd icanon echo isig
}
default {
exec {*}$sttycmd -raw echo <@$channel
}
}
}
catch {
tsv::set console is_raw 0
}
return done
}
proc enableRaw_mintty {{channel stdin}} {
#mintty specific enableRaw
upvar ::punk::console::previous_stty_state_$channel previous_stty_state_$channel
set sttycmd [auto_execok stty]
if {[set previous_stty_state_$channel] eq ""} {
if {[catch {exec {*}$sttycmd -g <@$channel} previous_stty_state_$channel]} {
set previous_stty_state_$channel ""
}
}
#REVIEW
switch $channel {
stdin {
exec {*}$sttycmd -icanon -echo -isig
}
default {
exec {*}$sttycmd raw -echo <@$channel
}
}
catch {
tsv::set console is_raw 1
}
#sometimes mintty on windows has -inputmode available - sometimes not
#sometimes mintty seems to need -inputmode to be set manually.
catch {
chan configure stdin -inputmode raw
}
return [dict create previous [set previous_stty_state_$channel]]
}
proc disableRaw_mintty {{channel stdin}} {
#mintty specific disableRaw
upvar ::punk::console::previous_stty_state_$channel previous_stty_state_$channel
set sttycmd [auto_execok stty]
if {[set previous_stty_state_$channel] ne ""} {
exec {*}$sttycmd [set previous_stty_state_$channel]
set previous_stty_state_$channel ""
puts stderr "previous stty state restored"
} else {
#REVIEW
switch $channel {
stdin {
exec {*}$sttycmd icanon echo isig
}
default {
exec {*}$sttycmd -raw echo <@$channel
}
}
}
catch {
tsv::set console is_raw 0
}
#sometimes mintty on windows has -inputmode available - sometimes not
#sometimes mintty seems to need -inputmode to be set manually.
catch {
chan configure stdin -inputmode normal
}
return done
}
}
if {"windows" eq $::tcl_platform(platform) && [info exists ::env(TERM)] && $::env(TERM) eq "mintty"} {
#note - TERM could also be mintty-direct - apparently for use with wsl.
# - we don't use terminfo or termcap here as we try to use ansi device queries etc. Todo - review.
#we seem to be running in mintty on windows - probably without winpty - so we should be able to use stty to set raw mode.
#override the windows enableRaw and disableRaw with the unix versions which use stty - as the twapi versions don't work in this environment.
#git bash uses mintty - but it seems to behave differently to msys mintty launched directly.
proc enableRaw {{channel stdin}} [info body ::punk::console::system::enableRaw_mintty]
proc disableRaw {{channel stdin}} [info body ::punk::console::system::disableRaw_mintty]
}
#review - document and decide granularity required. should we enable/disable more than one at once?
proc enable_mouse {} {
puts -nonewline stdout \x1b\[?1000h

81
src/bootsupport/modules/punk/du-0.1.0.tm

@ -1227,11 +1227,19 @@ namespace eval punk::du {
#only add to seen_entries after we have passed a glob regex check, to avoid marking entries as seen that we haven't actually processed yet.
set seen_entries [dict create]
foreach win_glob $win_glob_list tcl_re $tcl_regex_list {
if {$opt_patterndebug} {
puts stderr ">>>du_dirlisting_twapi winglob: $win_glob"
puts stderr ">>>du_dirlisting_twapi tclre : $tcl_re"
set debugreport ""
foreach win_glob $win_glob_list tcl_re $tcl_regex_list {
append debugreport ">>>du_dirlisting_twapi winglob: $win_glob" \n
append debugreport ">>>du_dirlisting_twapi tclre : $tcl_re" \n
}
append debugreport "------------------------------------" \n
append debugreport ">>>du_dirlisting_twapi folderpath: $folderpath" \n
append debugreport ">>>du_dirlisting_twapi tclglob : $tcl_glob" \n
append debugreport ">>>du_dirlisting_twapi querycount: [llength $win_glob_list]" \n
puts stderr $debugreport
}
foreach win_glob $win_glob_list tcl_re $tcl_regex_list {
#REVIEW! windows api pattern match https://www.red-gate.com/simple-talk/blogs/the-unexpected-behaviour-of-directoryinfo-getfiles-with-three-letter-extensions is .. weird. partly due to 8.3 filenames
#https://www.red-gate.com/simple-talk/blogs/the-unexpected-behaviour-of-directoryinfo-getfiles-with-three-letter-extensions/
@ -1384,6 +1392,8 @@ namespace eval punk::du {
set entry_archive 0
set entry_directory 0
set entry_link_to_file 0
set entry_link_to_directory 0
set entry_hidden 0
set entry_readonly 0
set entry_reparse_point 0
@ -1519,9 +1529,6 @@ namespace eval punk::du {
#this concept doesn't correspond 1-to-1 with unix links
#https://learn.microsoft.com/en-us/windows/win32/fileio/reparse-points
#review - and see which if any actually belong in the links key of our return
if {$skip_links} {
continue
}
#One thing it could be, is a 'mounted folder' https://learn.microsoft.com/en-us/windows/win32/fileio/determining-whether-a-directory-is-a-volume-mount-point
#
@ -1539,41 +1546,55 @@ namespace eval punk::du {
#
#Note also - a shortcut created in explorer with drag and drop to an existant folder is a different animal to a symlink (file with .lnk extension) even though it looks the same in explorer window.
#
#links are techically files too, whether they point to a file/dir or nothing.
#--------------------------------------
#review
#for consistency with tcl glob - we can't skip - it may point to a file or directory.
#--------------------------------------
if {!$entry_directory} {
#review - other attributes? will we see a link to a link here?
set entry_link_to_file 1
dict set linkdata target_type file
} else {
set entry_link_to_directory 1
dict set linkdata target_type directory
}
lappend links $fullname
#set ftype "l"
set do_sizes $do_sizes_l
set do_times $do_times_l
#review - other attributes? will we see a link to a link here?
#this branch will never be taken as we're currently setting either entry_link_to_file or entry_link_to_directory
#if {$skip_links && !$entry_link_to_directory && !$entry_link_to_file} {
# continue
#}
if {!$skip_links} {
lappend links $fullname
dict set linkdata linktype reparse_point
if {$opt_linkinfo} {
#dict set linkdata reparseinfo [dict get $attrdict -reparseinfo]
dict set linkdata reparseinfo $entry_reparse_info
}
}
if {$entry_directory} {
set do_sizes $do_sizes_l
set do_times $do_times_l
}
if {$skip_dirs && ($entry_directory || $entry_link_to_directory)} {
continue
} elseif {$entry_directory} {
#consider all directories to be executable for now - as this what TCL glob does on windows.
#review - should check ACLS if 'x' type is given, as seems to be done on unix.
if {$skip_dirs} {
continue
}
if {!$entry_reparse_point} {
#if {!$entry_reparse_point} {
lappend dirs $fullname
#set ftype "d"
set do_sizes $do_sizes_d
set do_times $do_times_d
} else {
#other mechanisms can't immediately classify a link as file vs directory - so we don't return this info in the main dirs/files collections
dict set linkdata target_type directory
}
#} else {
# dict set linkdata target_type directory
#}
}
if {!$entry_reparse_point && !$entry_directory} {
if {$entry_link_to_file || (!$entry_reparse_point && !$entry_directory)} {
#review - is anything that isn't a reparse_point or a directory, some sort of 'file' in this context? What about the 'device' attribute? Can that occur in a directory listing of some sort?
if {$skip_files} {
continue
@ -1620,9 +1641,6 @@ namespace eval punk::du {
m [twapi::large_system_time_to_secs_since_1970 [dict get $iteminfo mtime]]\
]
}
#if {[dict size $linkdata]} {
# dict set linkinfo $fullname $linkdata
#}
if {[llength $linkdata]} {
dict set linkinfo $fullname $linkdata
}
@ -1686,14 +1704,17 @@ namespace eval punk::du {
}
return $vfsmounts
}
#work around the horrible tilde-expansion thing (not needed for tcl 9+)
proc file_join_one {base newtail} {
#work around the horrible tilde-expansion thing (not needed for tcl 9+)
#note base could be c: or c:/
# we need to be careful not to introduce extra slashes - file join should already do the right thing.
if {[string index $newtail 0] ne {~}} {
#return [file join $base $newtail]
return $base/$newtail
return [file join $base $newtail]
#return $base/$newtail
}
#return [file join $base ./$newtail]
return $base/./$newtail
return [file join $base ./$newtail]
#return $base/./$newtail
}

7
src/bootsupport/modules/punk/lib-0.1.6.tm

@ -134,8 +134,9 @@ tcl::namespace::eval punk::lib::check {
#These are reported in warning output of 'help tcl' - or used for workarounds in some cases.
proc has_tclbug_caseinsensitiveglob_windows {} {
#https://core.tcl-lang.org/tcl/tktview/108904173c - not accepted
#https://core.tcl-lang.org/tcl/tktview/108904173c
set bug 0 ;#default only
if {"windows" ne $::tcl_platform(platform)} {
set bug 0
} else {
@ -151,10 +152,10 @@ tcl::namespace::eval punk::lib::check {
break
}
}
return [dict create bug $bug bugref 108904173c description "glob with patterns on windows can return inconsistently cased results - apparently by design." level warning]
}
#possibly related anomaly is that a returned result with case that doesn't match that of the file in the underlying filesystem can't be normalized
# to the correct case without doing some sort of string manipulation on the result such as 'string range $f 0 end' to affect the internal representation.
}
return [dict create bug $bug bugref 108904173c description "glob with patterns on windows can return inconsistently cased results" level medium]
}
#todo: it would be nice to test for the other portion of issue 108904173c - that on unix with a mounted case-insensitive filesystem we get other inconsistencies.

110
src/bootsupport/modules/punk/nav/fs-0.1.0.tm

@ -1651,7 +1651,7 @@ tcl::namespace::eval punk::nav::fs {
#This means accounting for prefixes of valid options and determining if they accept a parameter (which is allowed to begin with a dash) or not.
#Any argument that is in a possible option position and begins with a dash but isn't a valid option (or the -- itself)
#should raise an error rather than being treated as a literal glob pattern.
#set valid_options [list -directory -join -nocomplain -path -tails -types]
set valid_options [list -patterndebug -directory -join -nocomplain -path -tails -types]
#set solo_options [list -nocomplain -join -tails]
set options [dict create] ;#for solos we will set the value to 1, for options that take parameters we will set the value to the parameter
set patterns [list]
@ -1669,9 +1669,9 @@ tcl::namespace::eval punk::nav::fs {
break
}
#flag-like argument before -- we need to check if arg is a valid option or not
set full_option_name [tcl::prefix::match {-directory -join -nocomplain -path -tails -types} $a]
set full_option_name [tcl::prefix::match {-patterndebug -directory -join -nocomplain -path -tails -types} $a]
switch -- $full_option_name {
-directory - -path - -types {
-patterndebug - -directory - -path - -types {
#option takes a parameter - so next arg is parameter even if it looks like an option
if {$j < $arglen} {
dict set options $full_option_name [lindex $args $j]
@ -1681,9 +1681,12 @@ tcl::namespace::eval punk::nav::fs {
error "fglob: option \"$a\" requires a parameter but none found"
}
}
default {
-join - -nocomplain - -tails {
dict set options $full_option_name 1
}
default {
error "fglob: bad option \"$a\": must be a unique prefix of [join $valid_options ", "] or --"
}
}
}
#return [dict create options $options patterns $patterns]
@ -1701,6 +1704,11 @@ tcl::namespace::eval punk::nav::fs {
} else {
set types {}
}
if {[dict exists $options -patterndebug]} {
set opt_patterndebug [dict get $options -patterndebug]
} else {
set opt_patterndebug 0
}
#todo - fix for multiple absolute paths supplied.
#e.g c:/cmdfiles/*.exe c:/repo/jn/shellspy/bin/*.exe
@ -1711,7 +1719,7 @@ tcl::namespace::eval punk::nav::fs {
#It does not seem to sort or de-dup, or group results by type.
set results [list]
foreach pattern $patterns {
set resultd [dirfiles_dict -portabilitycheck 0 -searchbase $basedir -with_times 0 -with_sizes 0 -link_info 0 -types $types -tailglob $pattern]
set resultd [dirfiles_dict -patterndebug $opt_patterndebug -portabilitycheck 0 -searchbase $basedir -with_times 0 -with_sizes 0 -link_info 0 -types $types -tailglob $pattern]
#puts [showdict $resultd]
#todo - other types?
lappend results {*}[dict get $resultd dirs] {*}[dict get $resultd files] {*}[dict get $resultd links]
@ -1809,9 +1817,9 @@ tcl::namespace::eval punk::nav::fs {
foreach fileset [list dirs files links underlayfiles flaggedhidden flaggedreadonly flaggedsystem nonportable vfsmounts] {
set stripped [list]
foreach fullname [set $fileset] {
set shortname [strip_prefix_depth $fullname $common_base]
dict set fkeys $shortname $fullname ;#cache so we can retrieve already normalised name without re-hitting filesystem
lappend stripped $shortname
set base_relative_path [strip_prefix_depth $fullname $common_base]
dict set fkeys $base_relative_path $fullname ;#cache so we can retrieve already normalised name without re-hitting filesystem
lappend stripped $base_relative_path
}
set $fileset $stripped
}
@ -1826,6 +1834,7 @@ tcl::namespace::eval punk::nav::fs {
set file_symlinks [list]
set dir_symlinks [list]
set dir_shortcuts [list] ;#windows shell links (.lnk) that have a target that is a directory
set file_shortcuts [list] ;#windows shell links (.lnk) that have a target that is a file
foreach s $links {
if {[dict exists $contents linkinfo $s target_type]} {
#some mechanisms such as twapi can provide the target_type info so we don't have to re-hit the filesystem.
@ -1836,7 +1845,7 @@ tcl::namespace::eval punk::nav::fs {
}
directory {
lappend dir_symlinks $s
lappend dirs $s
#lappend dirs $s
}
default {
puts stderr "Warning - cannot determine link type for link $s (target_type value is:$target_type)"
@ -1849,7 +1858,7 @@ tcl::namespace::eval punk::nav::fs {
#will be appended in finfo_plus later
} elseif {[file isdirectory $s]} {
lappend dir_symlinks $s
lappend dirs $s
#lappend dirs $s
} else {
#dunno - warn for now
puts stderr "Warning - cannot determine link type for link $s"
@ -1899,23 +1908,7 @@ tcl::namespace::eval punk::nav::fs {
set ts "$key vs [dict keys [dict get $contents times]]"
}
set note ""
lappend finfo [list file $f display "[overtype::left $c2a $f] [overtype::right $c2b $s] [overtype::left $c2c "$ts $note"]"]
}
set flink_style [punk::ansi::a+ undercurly underline undt-green] ;#curly green underline with fallback to normal underline
set dlink_style [punk::ansi::a+ undercurly underline undt-green]
#We use an underline so the visual styling of a link can coexist with fg/bg colors applied for other attributes such as hidden
foreach flink $file_symlinks {
if {[dict size $fkeys]} {
set key [dict get $fkeys $flink]
} else {
set key $flink
}
if {[dict exists $contents times $key m]} {
set mtime [dict get $contents times $key m]
set ts [tcl::clock::format $mtime -format "%Y-%m-%d %H:%M:%S"]
} else {
set ts "[string repeat { } 19]"
}
if {$f in $file_symlinks} {
set note "link" ;#default only
if {[dict exists $contents linkinfo $key linktype]} {
if {[dict get $contents linkinfo $key linktype] eq "reparse_point"} {
@ -1927,9 +1920,41 @@ tcl::namespace::eval punk::nav::fs {
append note "$key vs [dict keys [dict get $contents linkinfo]]"
}
}
lappend finfo [list file $flink display "$flink_style[overtype::left $c2a $flink] [overtype::right $c2b 0] [overtype::left $c2c "$ts $note"]"]
}
lappend finfo [list file $f display "[overtype::left $c2a $f] [overtype::right $c2b $s] [overtype::left $c2c "$ts $note"]"]
}
set flink_style [punk::ansi::a+ undercurly underline undt-green] ;#curly green underline with fallback to normal underline
set dlink_style [punk::ansi::a+ undercurly underline undt-green]
#We use an underline so the visual styling of a link can coexist with fg/bg colors applied for other attributes such as hidden
#review
#foreach flink $file_symlinks {
# if {[dict size $fkeys]} {
# set key [dict get $fkeys $flink]
# } else {
# set key $flink
# }
# if {[dict exists $contents times $key m]} {
# set mtime [dict get $contents times $key m]
# set ts [tcl::clock::format $mtime -format "%Y-%m-%d %H:%M:%S"]
# } else {
# set ts "[string repeat { } 19]"
# }
# set note "link" ;#default only
# if {[dict exists $contents linkinfo $key linktype]} {
# if {[dict get $contents linkinfo $key linktype] eq "reparse_point"} {
# set note "reparse_point"
# if {[dict exists $contents linkinfo $key reparseinfo tag]} {
# append note " " [dict get $contents linkinfo $key reparseinfo tag]
# }
# } else {
# append note "$key vs [dict keys [dict get $contents linkinfo]]"
# }
# }
# lappend finfo [list file $flink display "$flink_style[overtype::left $c2a $flink] [overtype::right $c2b 0] [overtype::left $c2c "$ts $note"]"]
#}
set fshortcut_style [punk::ansi::a+ underdotted underline undt-hotpink]
set dshortcut_style [punk::ansi::a+ underdotted underline undt-hotpink]
#examine windows .lnk shell link files (shortcuts) - these could be encountered on other platforms too - we should still be able to read them
@ -1988,6 +2013,7 @@ tcl::namespace::eval punk::nav::fs {
}
dict set fdict display $display
lappend finfo_plus $fdict
lappend file_shortcuts $fname
}
directory {
#target of link is a dir - for display/categorisation purposes we want to see it as a dir
@ -2064,29 +2090,7 @@ tcl::namespace::eval punk::nav::fs {
#lappend d1_overrides underline undt-red ;#we use underlins to indicate symlinks and shortcuts, so we shouldn't use underlines here if possible.
lappend d1_overrides italic bold
}
#if {$d in $vfsmounts} {
# if {$d in $flaggedhidden} {
# #we could have a hidden dir which is also a vfs.. colour will be overridden giving no indication of 'hidden' status - REVIEW
# #(This situation encountered on windows - even though file attr showed -hidden 0 - the glob with -types hidden returned it.. possibly a tcl glob bug on windows)
# #mark it differently for now.. (todo bug report?)
# if {$d in $nonportable} {
# set d1 [punk::ansi::a+ red Yellow bold]
# } else {
# set d1 [punk::ansi::a+ green Purple bold]
# }
# } else {
# if {$d in $nonportable} {
# set d1 [punk::ansi::a+ red White bold]
# } else {
# set d1 [punk::ansi::a+ green bold]
# }
# }
#} else {
# if {$d in $nonportable} {
# set d1 [punk::ansi::a+ red bold]
# }
#}
#dlink-style & dshortcut_style are for underlines - can be added with colours already set
#dlink_style & dshortcut_style are for underlines - can be added with colours already set
if {[llength $d1_overrides]} {
set d1 [punk::ansi::a+ {*}$d1_overrides]
@ -2111,6 +2115,10 @@ tcl::namespace::eval punk::nav::fs {
if {[llength $f1_overrides]} {
set f1 [punk::ansi::a+ {*}$f1_overrides]
}
if {$fname in $file_symlinks} {
append f1 $flink_style
}
#fshortcut_style already set in the display string for shortcuts targeting files, so we don't need to add it here.
lappend displaylist [overtype::left $col1 $d1$d$RST]$f1$fdisp$RST
} else {
#either there are no files or opt_listing is / = show dirs only (some of which may have actually been files that were links/shortcuts to directories)

23
src/bootsupport/modules/punk/repl-0.1.2.tm

@ -92,8 +92,27 @@ package require textblock
if {![info exists ::env(SHELL)]} {
set ::env(SHELL) punk86
#we'll follow posix convention of env(SHELL) being set to the absolute path of the shell executable
#reference: https://pubs.opengroup.org/onlinepubs/9799919799/basedefs/V1_chap08.html
#For example if we launch mintty from within punk, it will pick this up and then launch the new mintty with this shell. seems reasonable.
#some terminals launched from within punk will ignore this - but maintain the value: e.g tabby, rio
#others might ignore it but also clear or not pass it e.g wt, wezterm
#terminals that ignore it are presumably using a stored default shell from their own config.
#shell programs such as cmd.exe, powershell.exe seem to maintain the env variable if launched from within punk.
#we will respect the existing env(SHELL) if it is set
#- as that is the standard way to indicate the user's preferred shell - but if it isn't set, we'll set it to the current executable.
#This allows child processes launched from the shell to pick up on the fact they are running in a shell environment, and also allows nested shells to work correctly.
#review - what about the args the current shell was launched with?
set ::env(SHELL) [file normalize [info nameofexecutable]]
}
if {![info exists ::env(TERM)]} {
# tset -r seems to rely on env(TERM) - so this doesn't seem to work
#if {![catch {exec tset -r} result]} {
@ -1429,6 +1448,8 @@ proc repl::repl_handler {inputchan readmore prompt_config} {
set rawmode 0
set original_input_conf [chan configure $inputchan] ;#whether repl is in line or raw mode - we restore the inputchan (stdin) state
if {[dict exists $original_input_conf -inputmode]} {
#review - when terminal is mintty and we switch to raw mode, the change isn't relected in chan configures '-inputmode' why?
if {[dict get $original_input_conf -inputmode] eq "raw"} {
#user or script has apparently put stdin into raw mode - update punk::console::is_raw to match
set rawmode 1

4
src/bootsupport/modules/punk/winlnk-0.1.1.tm

@ -1011,7 +1011,7 @@ tcl::namespace::eval punk::winlnk {
-summary\
"Show information about a .lnk file (windows shortcut)"\
-help\
"Print to stdout the information obtained by parsing the binary data in a windows .lnk file, in a human readable format.
"Return information obtained by parsing the binary data in a windows .lnk file, in a human readable format.
If the .lnk header check fails, then the .lnk file probably isn't really a shortcut file and an error message will be printed."
@values -min 1 -max 1
path -type string -help "Path to the .lnk file to resolve"
@ -1048,7 +1048,7 @@ tcl::namespace::eval punk::winlnk {
append querystring "$field "
}
}
puts "querystring: $querystring"
#puts "querystring: $querystring"
return [punk::lib::showdict $info {*}$querystring]
}
}

2
src/modules/punk/args-999999.0a1.0.tm

@ -9387,7 +9387,6 @@ tcl::namespace::eval punk::args {
set chosen $bestmatch
set choice_in_list 1
}
puts ">>>>> chosen: $chosen bestmatch: $bestmatch for c_check: $c_check choices_test: $choices_test allchoices: $allchoices"
} else {
set chosen [tcl::prefix::match -error "" [list {*}[lsort -unique $allchoices] {*}$choiceprefixreservelist] $c_check]
if {$chosen eq "" || $chosen in $choiceprefixreservelist} {
@ -9413,7 +9412,6 @@ tcl::namespace::eval punk::args {
if {$choicemultiple_max != -1 && $choicemultiple_max < 2} {
#single choice allowed per clause-member
if {$is_multiple} {
puts ">>>>> existing:'$existing' element_index:$element_index choice_index:$choice_idx chosen: $chosen"
if {$clause_size == 1} {
#no list wrapping of single element in $dname dict - so don't index into it with element_index
#lset existing $element_index $chosen ;#wrong - test::punk::args test: choice_multiple_with_choiceprefix.

123
src/modules/punk/console-999999.0a1.0.tm

@ -87,6 +87,8 @@ namespace eval punk::console {
#Note that windows terminal cooked mode seems to use 8 for interactive use even if set differently
#e.g typing tab characters may still be echoed 8-spaced while writing to stdout my obey the terminal's tab stops.
variable has_twapi 0
variable previous_stty_state_stdin ""
variable previous_stty_state_stdout ""
variable previous_stty_state_stderr ""
@ -565,7 +567,128 @@ namespace eval punk::console {
return done
}
}
namespace eval system {
proc enableRaw_unix {{channel stdin}} {
upvar ::punk::console::previous_stty_state_$channel previous_stty_state_$channel
set sttycmd [auto_execok stty]
if {[set previous_stty_state_$channel] eq ""} {
if {[catch {exec {*}$sttycmd -g <@$channel} previous_stty_state_$channel]} {
set previous_stty_state_$channel ""
}
}
#REVIEW
switch $channel {
stdin {
exec {*}$sttycmd -icanon -echo -isig
}
default {
exec {*}$sttycmd raw -echo <@$channel
}
}
catch {
tsv::set console is_raw 1
}
return [dict create previous [set previous_stty_state_$channel]]
}
proc disableRaw_unix {{channel stdin}} {
upvar ::punk::console::previous_stty_state_$channel previous_stty_state_$channel
set sttycmd [auto_execok stty]
if {[set previous_stty_state_$channel] ne ""} {
exec {*}$sttycmd [set previous_stty_state_$channel]
set previous_stty_state_$channel ""
} else {
#REVIEW
switch $channel {
stdin {
exec {*}$sttycmd icanon echo isig
}
default {
exec {*}$sttycmd -raw echo <@$channel
}
}
}
catch {
tsv::set console is_raw 0
}
return done
}
proc enableRaw_mintty {{channel stdin}} {
#mintty specific enableRaw
upvar ::punk::console::previous_stty_state_$channel previous_stty_state_$channel
set sttycmd [auto_execok stty]
if {[set previous_stty_state_$channel] eq ""} {
if {[catch {exec {*}$sttycmd -g <@$channel} previous_stty_state_$channel]} {
set previous_stty_state_$channel ""
}
}
#REVIEW
switch $channel {
stdin {
exec {*}$sttycmd -icanon -echo -isig
}
default {
exec {*}$sttycmd raw -echo <@$channel
}
}
catch {
tsv::set console is_raw 1
}
#sometimes mintty on windows has -inputmode available - sometimes not
#sometimes mintty seems to need -inputmode to be set manually.
catch {
chan configure stdin -inputmode raw
}
return [dict create previous [set previous_stty_state_$channel]]
}
proc disableRaw_mintty {{channel stdin}} {
#mintty specific disableRaw
upvar ::punk::console::previous_stty_state_$channel previous_stty_state_$channel
set sttycmd [auto_execok stty]
if {[set previous_stty_state_$channel] ne ""} {
exec {*}$sttycmd [set previous_stty_state_$channel]
set previous_stty_state_$channel ""
puts stderr "previous stty state restored"
} else {
#REVIEW
switch $channel {
stdin {
exec {*}$sttycmd icanon echo isig
}
default {
exec {*}$sttycmd -raw echo <@$channel
}
}
}
catch {
tsv::set console is_raw 0
}
#sometimes mintty on windows has -inputmode available - sometimes not
#sometimes mintty seems to need -inputmode to be set manually.
catch {
chan configure stdin -inputmode normal
}
return done
}
}
if {"windows" eq $::tcl_platform(platform) && [info exists ::env(TERM)] && $::env(TERM) eq "mintty"} {
#note - TERM could also be mintty-direct - apparently for use with wsl.
# - we don't use terminfo or termcap here as we try to use ansi device queries etc. Todo - review.
#we seem to be running in mintty on windows - probably without winpty - so we should be able to use stty to set raw mode.
#override the windows enableRaw and disableRaw with the unix versions which use stty - as the twapi versions don't work in this environment.
#git bash uses mintty - but it seems to behave differently to msys mintty launched directly.
proc enableRaw {{channel stdin}} [info body ::punk::console::system::enableRaw_mintty]
proc disableRaw {{channel stdin}} [info body ::punk::console::system::disableRaw_mintty]
}
#review - document and decide granularity required. should we enable/disable more than one at once?
proc enable_mouse {} {
puts -nonewline stdout \x1b\[?1000h

81
src/modules/punk/du-999999.0a1.0.tm

@ -1227,11 +1227,19 @@ namespace eval punk::du {
#only add to seen_entries after we have passed a glob regex check, to avoid marking entries as seen that we haven't actually processed yet.
set seen_entries [dict create]
foreach win_glob $win_glob_list tcl_re $tcl_regex_list {
if {$opt_patterndebug} {
puts stderr ">>>du_dirlisting_twapi winglob: $win_glob"
puts stderr ">>>du_dirlisting_twapi tclre : $tcl_re"
set debugreport ""
foreach win_glob $win_glob_list tcl_re $tcl_regex_list {
append debugreport ">>>du_dirlisting_twapi winglob: $win_glob" \n
append debugreport ">>>du_dirlisting_twapi tclre : $tcl_re" \n
}
append debugreport "------------------------------------" \n
append debugreport ">>>du_dirlisting_twapi folderpath: $folderpath" \n
append debugreport ">>>du_dirlisting_twapi tclglob : $tcl_glob" \n
append debugreport ">>>du_dirlisting_twapi querycount: [llength $win_glob_list]" \n
puts stderr $debugreport
}
foreach win_glob $win_glob_list tcl_re $tcl_regex_list {
#REVIEW! windows api pattern match https://www.red-gate.com/simple-talk/blogs/the-unexpected-behaviour-of-directoryinfo-getfiles-with-three-letter-extensions is .. weird. partly due to 8.3 filenames
#https://www.red-gate.com/simple-talk/blogs/the-unexpected-behaviour-of-directoryinfo-getfiles-with-three-letter-extensions/
@ -1384,6 +1392,8 @@ namespace eval punk::du {
set entry_archive 0
set entry_directory 0
set entry_link_to_file 0
set entry_link_to_directory 0
set entry_hidden 0
set entry_readonly 0
set entry_reparse_point 0
@ -1519,9 +1529,6 @@ namespace eval punk::du {
#this concept doesn't correspond 1-to-1 with unix links
#https://learn.microsoft.com/en-us/windows/win32/fileio/reparse-points
#review - and see which if any actually belong in the links key of our return
if {$skip_links} {
continue
}
#One thing it could be, is a 'mounted folder' https://learn.microsoft.com/en-us/windows/win32/fileio/determining-whether-a-directory-is-a-volume-mount-point
#
@ -1539,41 +1546,55 @@ namespace eval punk::du {
#
#Note also - a shortcut created in explorer with drag and drop to an existant folder is a different animal to a symlink (file with .lnk extension) even though it looks the same in explorer window.
#
#links are techically files too, whether they point to a file/dir or nothing.
#--------------------------------------
#review
#for consistency with tcl glob - we can't skip - it may point to a file or directory.
#--------------------------------------
if {!$entry_directory} {
#review - other attributes? will we see a link to a link here?
set entry_link_to_file 1
dict set linkdata target_type file
} else {
set entry_link_to_directory 1
dict set linkdata target_type directory
}
lappend links $fullname
#set ftype "l"
set do_sizes $do_sizes_l
set do_times $do_times_l
#review - other attributes? will we see a link to a link here?
#this branch will never be taken as we're currently setting either entry_link_to_file or entry_link_to_directory
#if {$skip_links && !$entry_link_to_directory && !$entry_link_to_file} {
# continue
#}
if {!$skip_links} {
lappend links $fullname
dict set linkdata linktype reparse_point
if {$opt_linkinfo} {
#dict set linkdata reparseinfo [dict get $attrdict -reparseinfo]
dict set linkdata reparseinfo $entry_reparse_info
}
}
if {$entry_directory} {
set do_sizes $do_sizes_l
set do_times $do_times_l
}
if {$skip_dirs && ($entry_directory || $entry_link_to_directory)} {
continue
} elseif {$entry_directory} {
#consider all directories to be executable for now - as this what TCL glob does on windows.
#review - should check ACLS if 'x' type is given, as seems to be done on unix.
if {$skip_dirs} {
continue
}
if {!$entry_reparse_point} {
#if {!$entry_reparse_point} {
lappend dirs $fullname
#set ftype "d"
set do_sizes $do_sizes_d
set do_times $do_times_d
} else {
#other mechanisms can't immediately classify a link as file vs directory - so we don't return this info in the main dirs/files collections
dict set linkdata target_type directory
}
#} else {
# dict set linkdata target_type directory
#}
}
if {!$entry_reparse_point && !$entry_directory} {
if {$entry_link_to_file || (!$entry_reparse_point && !$entry_directory)} {
#review - is anything that isn't a reparse_point or a directory, some sort of 'file' in this context? What about the 'device' attribute? Can that occur in a directory listing of some sort?
if {$skip_files} {
continue
@ -1620,9 +1641,6 @@ namespace eval punk::du {
m [twapi::large_system_time_to_secs_since_1970 [dict get $iteminfo mtime]]\
]
}
#if {[dict size $linkdata]} {
# dict set linkinfo $fullname $linkdata
#}
if {[llength $linkdata]} {
dict set linkinfo $fullname $linkdata
}
@ -1686,14 +1704,17 @@ namespace eval punk::du {
}
return $vfsmounts
}
#work around the horrible tilde-expansion thing (not needed for tcl 9+)
proc file_join_one {base newtail} {
#work around the horrible tilde-expansion thing (not needed for tcl 9+)
#note base could be c: or c:/
# we need to be careful not to introduce extra slashes - file join should already do the right thing.
if {[string index $newtail 0] ne {~}} {
#return [file join $base $newtail]
return $base/$newtail
return [file join $base $newtail]
#return $base/$newtail
}
#return [file join $base ./$newtail]
return $base/./$newtail
return [file join $base ./$newtail]
#return $base/./$newtail
}

7
src/modules/punk/lib-999999.0a1.0.tm

@ -134,8 +134,9 @@ tcl::namespace::eval punk::lib::check {
#These are reported in warning output of 'help tcl' - or used for workarounds in some cases.
proc has_tclbug_caseinsensitiveglob_windows {} {
#https://core.tcl-lang.org/tcl/tktview/108904173c - not accepted
#https://core.tcl-lang.org/tcl/tktview/108904173c
set bug 0 ;#default only
if {"windows" ne $::tcl_platform(platform)} {
set bug 0
} else {
@ -151,10 +152,10 @@ tcl::namespace::eval punk::lib::check {
break
}
}
return [dict create bug $bug bugref 108904173c description "glob with patterns on windows can return inconsistently cased results - apparently by design." level warning]
}
#possibly related anomaly is that a returned result with case that doesn't match that of the file in the underlying filesystem can't be normalized
# to the correct case without doing some sort of string manipulation on the result such as 'string range $f 0 end' to affect the internal representation.
}
return [dict create bug $bug bugref 108904173c description "glob with patterns on windows can return inconsistently cased results" level medium]
}
#todo: it would be nice to test for the other portion of issue 108904173c - that on unix with a mounted case-insensitive filesystem we get other inconsistencies.

110
src/modules/punk/nav/fs-999999.0a1.0.tm

@ -1651,7 +1651,7 @@ tcl::namespace::eval punk::nav::fs {
#This means accounting for prefixes of valid options and determining if they accept a parameter (which is allowed to begin with a dash) or not.
#Any argument that is in a possible option position and begins with a dash but isn't a valid option (or the -- itself)
#should raise an error rather than being treated as a literal glob pattern.
#set valid_options [list -directory -join -nocomplain -path -tails -types]
set valid_options [list -patterndebug -directory -join -nocomplain -path -tails -types]
#set solo_options [list -nocomplain -join -tails]
set options [dict create] ;#for solos we will set the value to 1, for options that take parameters we will set the value to the parameter
set patterns [list]
@ -1669,9 +1669,9 @@ tcl::namespace::eval punk::nav::fs {
break
}
#flag-like argument before -- we need to check if arg is a valid option or not
set full_option_name [tcl::prefix::match {-directory -join -nocomplain -path -tails -types} $a]
set full_option_name [tcl::prefix::match {-patterndebug -directory -join -nocomplain -path -tails -types} $a]
switch -- $full_option_name {
-directory - -path - -types {
-patterndebug - -directory - -path - -types {
#option takes a parameter - so next arg is parameter even if it looks like an option
if {$j < $arglen} {
dict set options $full_option_name [lindex $args $j]
@ -1681,9 +1681,12 @@ tcl::namespace::eval punk::nav::fs {
error "fglob: option \"$a\" requires a parameter but none found"
}
}
default {
-join - -nocomplain - -tails {
dict set options $full_option_name 1
}
default {
error "fglob: bad option \"$a\": must be a unique prefix of [join $valid_options ", "] or --"
}
}
}
#return [dict create options $options patterns $patterns]
@ -1701,6 +1704,11 @@ tcl::namespace::eval punk::nav::fs {
} else {
set types {}
}
if {[dict exists $options -patterndebug]} {
set opt_patterndebug [dict get $options -patterndebug]
} else {
set opt_patterndebug 0
}
#todo - fix for multiple absolute paths supplied.
#e.g c:/cmdfiles/*.exe c:/repo/jn/shellspy/bin/*.exe
@ -1711,7 +1719,7 @@ tcl::namespace::eval punk::nav::fs {
#It does not seem to sort or de-dup, or group results by type.
set results [list]
foreach pattern $patterns {
set resultd [dirfiles_dict -portabilitycheck 0 -searchbase $basedir -with_times 0 -with_sizes 0 -link_info 0 -types $types -tailglob $pattern]
set resultd [dirfiles_dict -patterndebug $opt_patterndebug -portabilitycheck 0 -searchbase $basedir -with_times 0 -with_sizes 0 -link_info 0 -types $types -tailglob $pattern]
#puts [showdict $resultd]
#todo - other types?
lappend results {*}[dict get $resultd dirs] {*}[dict get $resultd files] {*}[dict get $resultd links]
@ -1809,9 +1817,9 @@ tcl::namespace::eval punk::nav::fs {
foreach fileset [list dirs files links underlayfiles flaggedhidden flaggedreadonly flaggedsystem nonportable vfsmounts] {
set stripped [list]
foreach fullname [set $fileset] {
set shortname [strip_prefix_depth $fullname $common_base]
dict set fkeys $shortname $fullname ;#cache so we can retrieve already normalised name without re-hitting filesystem
lappend stripped $shortname
set base_relative_path [strip_prefix_depth $fullname $common_base]
dict set fkeys $base_relative_path $fullname ;#cache so we can retrieve already normalised name without re-hitting filesystem
lappend stripped $base_relative_path
}
set $fileset $stripped
}
@ -1826,6 +1834,7 @@ tcl::namespace::eval punk::nav::fs {
set file_symlinks [list]
set dir_symlinks [list]
set dir_shortcuts [list] ;#windows shell links (.lnk) that have a target that is a directory
set file_shortcuts [list] ;#windows shell links (.lnk) that have a target that is a file
foreach s $links {
if {[dict exists $contents linkinfo $s target_type]} {
#some mechanisms such as twapi can provide the target_type info so we don't have to re-hit the filesystem.
@ -1836,7 +1845,7 @@ tcl::namespace::eval punk::nav::fs {
}
directory {
lappend dir_symlinks $s
lappend dirs $s
#lappend dirs $s
}
default {
puts stderr "Warning - cannot determine link type for link $s (target_type value is:$target_type)"
@ -1849,7 +1858,7 @@ tcl::namespace::eval punk::nav::fs {
#will be appended in finfo_plus later
} elseif {[file isdirectory $s]} {
lappend dir_symlinks $s
lappend dirs $s
#lappend dirs $s
} else {
#dunno - warn for now
puts stderr "Warning - cannot determine link type for link $s"
@ -1899,23 +1908,7 @@ tcl::namespace::eval punk::nav::fs {
set ts "$key vs [dict keys [dict get $contents times]]"
}
set note ""
lappend finfo [list file $f display "[overtype::left $c2a $f] [overtype::right $c2b $s] [overtype::left $c2c "$ts $note"]"]
}
set flink_style [punk::ansi::a+ undercurly underline undt-green] ;#curly green underline with fallback to normal underline
set dlink_style [punk::ansi::a+ undercurly underline undt-green]
#We use an underline so the visual styling of a link can coexist with fg/bg colors applied for other attributes such as hidden
foreach flink $file_symlinks {
if {[dict size $fkeys]} {
set key [dict get $fkeys $flink]
} else {
set key $flink
}
if {[dict exists $contents times $key m]} {
set mtime [dict get $contents times $key m]
set ts [tcl::clock::format $mtime -format "%Y-%m-%d %H:%M:%S"]
} else {
set ts "[string repeat { } 19]"
}
if {$f in $file_symlinks} {
set note "link" ;#default only
if {[dict exists $contents linkinfo $key linktype]} {
if {[dict get $contents linkinfo $key linktype] eq "reparse_point"} {
@ -1927,9 +1920,41 @@ tcl::namespace::eval punk::nav::fs {
append note "$key vs [dict keys [dict get $contents linkinfo]]"
}
}
lappend finfo [list file $flink display "$flink_style[overtype::left $c2a $flink] [overtype::right $c2b 0] [overtype::left $c2c "$ts $note"]"]
}
lappend finfo [list file $f display "[overtype::left $c2a $f] [overtype::right $c2b $s] [overtype::left $c2c "$ts $note"]"]
}
set flink_style [punk::ansi::a+ undercurly underline undt-green] ;#curly green underline with fallback to normal underline
set dlink_style [punk::ansi::a+ undercurly underline undt-green]
#We use an underline so the visual styling of a link can coexist with fg/bg colors applied for other attributes such as hidden
#review
#foreach flink $file_symlinks {
# if {[dict size $fkeys]} {
# set key [dict get $fkeys $flink]
# } else {
# set key $flink
# }
# if {[dict exists $contents times $key m]} {
# set mtime [dict get $contents times $key m]
# set ts [tcl::clock::format $mtime -format "%Y-%m-%d %H:%M:%S"]
# } else {
# set ts "[string repeat { } 19]"
# }
# set note "link" ;#default only
# if {[dict exists $contents linkinfo $key linktype]} {
# if {[dict get $contents linkinfo $key linktype] eq "reparse_point"} {
# set note "reparse_point"
# if {[dict exists $contents linkinfo $key reparseinfo tag]} {
# append note " " [dict get $contents linkinfo $key reparseinfo tag]
# }
# } else {
# append note "$key vs [dict keys [dict get $contents linkinfo]]"
# }
# }
# lappend finfo [list file $flink display "$flink_style[overtype::left $c2a $flink] [overtype::right $c2b 0] [overtype::left $c2c "$ts $note"]"]
#}
set fshortcut_style [punk::ansi::a+ underdotted underline undt-hotpink]
set dshortcut_style [punk::ansi::a+ underdotted underline undt-hotpink]
#examine windows .lnk shell link files (shortcuts) - these could be encountered on other platforms too - we should still be able to read them
@ -1988,6 +2013,7 @@ tcl::namespace::eval punk::nav::fs {
}
dict set fdict display $display
lappend finfo_plus $fdict
lappend file_shortcuts $fname
}
directory {
#target of link is a dir - for display/categorisation purposes we want to see it as a dir
@ -2064,29 +2090,7 @@ tcl::namespace::eval punk::nav::fs {
#lappend d1_overrides underline undt-red ;#we use underlins to indicate symlinks and shortcuts, so we shouldn't use underlines here if possible.
lappend d1_overrides italic bold
}
#if {$d in $vfsmounts} {
# if {$d in $flaggedhidden} {
# #we could have a hidden dir which is also a vfs.. colour will be overridden giving no indication of 'hidden' status - REVIEW
# #(This situation encountered on windows - even though file attr showed -hidden 0 - the glob with -types hidden returned it.. possibly a tcl glob bug on windows)
# #mark it differently for now.. (todo bug report?)
# if {$d in $nonportable} {
# set d1 [punk::ansi::a+ red Yellow bold]
# } else {
# set d1 [punk::ansi::a+ green Purple bold]
# }
# } else {
# if {$d in $nonportable} {
# set d1 [punk::ansi::a+ red White bold]
# } else {
# set d1 [punk::ansi::a+ green bold]
# }
# }
#} else {
# if {$d in $nonportable} {
# set d1 [punk::ansi::a+ red bold]
# }
#}
#dlink-style & dshortcut_style are for underlines - can be added with colours already set
#dlink_style & dshortcut_style are for underlines - can be added with colours already set
if {[llength $d1_overrides]} {
set d1 [punk::ansi::a+ {*}$d1_overrides]
@ -2111,6 +2115,10 @@ tcl::namespace::eval punk::nav::fs {
if {[llength $f1_overrides]} {
set f1 [punk::ansi::a+ {*}$f1_overrides]
}
if {$fname in $file_symlinks} {
append f1 $flink_style
}
#fshortcut_style already set in the display string for shortcuts targeting files, so we don't need to add it here.
lappend displaylist [overtype::left $col1 $d1$d$RST]$f1$fdisp$RST
} else {
#either there are no files or opt_listing is / = show dirs only (some of which may have actually been files that were links/shortcuts to directories)

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

@ -92,8 +92,27 @@ package require textblock
if {![info exists ::env(SHELL)]} {
set ::env(SHELL) punk86
#we'll follow posix convention of env(SHELL) being set to the absolute path of the shell executable
#reference: https://pubs.opengroup.org/onlinepubs/9799919799/basedefs/V1_chap08.html
#For example if we launch mintty from within punk, it will pick this up and then launch the new mintty with this shell. seems reasonable.
#some terminals launched from within punk will ignore this - but maintain the value: e.g tabby, rio
#others might ignore it but also clear or not pass it e.g wt, wezterm
#terminals that ignore it are presumably using a stored default shell from their own config.
#shell programs such as cmd.exe, powershell.exe seem to maintain the env variable if launched from within punk.
#we will respect the existing env(SHELL) if it is set
#- as that is the standard way to indicate the user's preferred shell - but if it isn't set, we'll set it to the current executable.
#This allows child processes launched from the shell to pick up on the fact they are running in a shell environment, and also allows nested shells to work correctly.
#review - what about the args the current shell was launched with?
set ::env(SHELL) [file normalize [info nameofexecutable]]
}
if {![info exists ::env(TERM)]} {
# tset -r seems to rely on env(TERM) - so this doesn't seem to work
#if {![catch {exec tset -r} result]} {
@ -1429,6 +1448,8 @@ proc repl::repl_handler {inputchan readmore prompt_config} {
set rawmode 0
set original_input_conf [chan configure $inputchan] ;#whether repl is in line or raw mode - we restore the inputchan (stdin) state
if {[dict exists $original_input_conf -inputmode]} {
#review - when terminal is mintty and we switch to raw mode, the change isn't relected in chan configures '-inputmode' why?
if {[dict get $original_input_conf -inputmode] eq "raw"} {
#user or script has apparently put stdin into raw mode - update punk::console::is_raw to match
set rawmode 1

2
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.2.1.tm

@ -9387,7 +9387,6 @@ tcl::namespace::eval punk::args {
set chosen $bestmatch
set choice_in_list 1
}
puts ">>>>> chosen: $chosen bestmatch: $bestmatch for c_check: $c_check choices_test: $choices_test allchoices: $allchoices"
} else {
set chosen [tcl::prefix::match -error "" [list {*}[lsort -unique $allchoices] {*}$choiceprefixreservelist] $c_check]
if {$chosen eq "" || $chosen in $choiceprefixreservelist} {
@ -9413,7 +9412,6 @@ tcl::namespace::eval punk::args {
if {$choicemultiple_max != -1 && $choicemultiple_max < 2} {
#single choice allowed per clause-member
if {$is_multiple} {
puts ">>>>> existing:'$existing' element_index:$element_index choice_index:$choice_idx chosen: $chosen"
if {$clause_size == 1} {
#no list wrapping of single element in $dname dict - so don't index into it with element_index
#lset existing $element_index $chosen ;#wrong - test::punk::args test: choice_multiple_with_choiceprefix.

123
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.1.1.tm

@ -87,6 +87,8 @@ namespace eval punk::console {
#Note that windows terminal cooked mode seems to use 8 for interactive use even if set differently
#e.g typing tab characters may still be echoed 8-spaced while writing to stdout my obey the terminal's tab stops.
variable has_twapi 0
variable previous_stty_state_stdin ""
variable previous_stty_state_stdout ""
variable previous_stty_state_stderr ""
@ -565,7 +567,128 @@ namespace eval punk::console {
return done
}
}
namespace eval system {
proc enableRaw_unix {{channel stdin}} {
upvar ::punk::console::previous_stty_state_$channel previous_stty_state_$channel
set sttycmd [auto_execok stty]
if {[set previous_stty_state_$channel] eq ""} {
if {[catch {exec {*}$sttycmd -g <@$channel} previous_stty_state_$channel]} {
set previous_stty_state_$channel ""
}
}
#REVIEW
switch $channel {
stdin {
exec {*}$sttycmd -icanon -echo -isig
}
default {
exec {*}$sttycmd raw -echo <@$channel
}
}
catch {
tsv::set console is_raw 1
}
return [dict create previous [set previous_stty_state_$channel]]
}
proc disableRaw_unix {{channel stdin}} {
upvar ::punk::console::previous_stty_state_$channel previous_stty_state_$channel
set sttycmd [auto_execok stty]
if {[set previous_stty_state_$channel] ne ""} {
exec {*}$sttycmd [set previous_stty_state_$channel]
set previous_stty_state_$channel ""
} else {
#REVIEW
switch $channel {
stdin {
exec {*}$sttycmd icanon echo isig
}
default {
exec {*}$sttycmd -raw echo <@$channel
}
}
}
catch {
tsv::set console is_raw 0
}
return done
}
proc enableRaw_mintty {{channel stdin}} {
#mintty specific enableRaw
upvar ::punk::console::previous_stty_state_$channel previous_stty_state_$channel
set sttycmd [auto_execok stty]
if {[set previous_stty_state_$channel] eq ""} {
if {[catch {exec {*}$sttycmd -g <@$channel} previous_stty_state_$channel]} {
set previous_stty_state_$channel ""
}
}
#REVIEW
switch $channel {
stdin {
exec {*}$sttycmd -icanon -echo -isig
}
default {
exec {*}$sttycmd raw -echo <@$channel
}
}
catch {
tsv::set console is_raw 1
}
#sometimes mintty on windows has -inputmode available - sometimes not
#sometimes mintty seems to need -inputmode to be set manually.
catch {
chan configure stdin -inputmode raw
}
return [dict create previous [set previous_stty_state_$channel]]
}
proc disableRaw_mintty {{channel stdin}} {
#mintty specific disableRaw
upvar ::punk::console::previous_stty_state_$channel previous_stty_state_$channel
set sttycmd [auto_execok stty]
if {[set previous_stty_state_$channel] ne ""} {
exec {*}$sttycmd [set previous_stty_state_$channel]
set previous_stty_state_$channel ""
puts stderr "previous stty state restored"
} else {
#REVIEW
switch $channel {
stdin {
exec {*}$sttycmd icanon echo isig
}
default {
exec {*}$sttycmd -raw echo <@$channel
}
}
}
catch {
tsv::set console is_raw 0
}
#sometimes mintty on windows has -inputmode available - sometimes not
#sometimes mintty seems to need -inputmode to be set manually.
catch {
chan configure stdin -inputmode normal
}
return done
}
}
if {"windows" eq $::tcl_platform(platform) && [info exists ::env(TERM)] && $::env(TERM) eq "mintty"} {
#note - TERM could also be mintty-direct - apparently for use with wsl.
# - we don't use terminfo or termcap here as we try to use ansi device queries etc. Todo - review.
#we seem to be running in mintty on windows - probably without winpty - so we should be able to use stty to set raw mode.
#override the windows enableRaw and disableRaw with the unix versions which use stty - as the twapi versions don't work in this environment.
#git bash uses mintty - but it seems to behave differently to msys mintty launched directly.
proc enableRaw {{channel stdin}} [info body ::punk::console::system::enableRaw_mintty]
proc disableRaw {{channel stdin}} [info body ::punk::console::system::disableRaw_mintty]
}
#review - document and decide granularity required. should we enable/disable more than one at once?
proc enable_mouse {} {
puts -nonewline stdout \x1b\[?1000h

81
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/du-0.1.0.tm

@ -1227,11 +1227,19 @@ namespace eval punk::du {
#only add to seen_entries after we have passed a glob regex check, to avoid marking entries as seen that we haven't actually processed yet.
set seen_entries [dict create]
foreach win_glob $win_glob_list tcl_re $tcl_regex_list {
if {$opt_patterndebug} {
puts stderr ">>>du_dirlisting_twapi winglob: $win_glob"
puts stderr ">>>du_dirlisting_twapi tclre : $tcl_re"
set debugreport ""
foreach win_glob $win_glob_list tcl_re $tcl_regex_list {
append debugreport ">>>du_dirlisting_twapi winglob: $win_glob" \n
append debugreport ">>>du_dirlisting_twapi tclre : $tcl_re" \n
}
append debugreport "------------------------------------" \n
append debugreport ">>>du_dirlisting_twapi folderpath: $folderpath" \n
append debugreport ">>>du_dirlisting_twapi tclglob : $tcl_glob" \n
append debugreport ">>>du_dirlisting_twapi querycount: [llength $win_glob_list]" \n
puts stderr $debugreport
}
foreach win_glob $win_glob_list tcl_re $tcl_regex_list {
#REVIEW! windows api pattern match https://www.red-gate.com/simple-talk/blogs/the-unexpected-behaviour-of-directoryinfo-getfiles-with-three-letter-extensions is .. weird. partly due to 8.3 filenames
#https://www.red-gate.com/simple-talk/blogs/the-unexpected-behaviour-of-directoryinfo-getfiles-with-three-letter-extensions/
@ -1384,6 +1392,8 @@ namespace eval punk::du {
set entry_archive 0
set entry_directory 0
set entry_link_to_file 0
set entry_link_to_directory 0
set entry_hidden 0
set entry_readonly 0
set entry_reparse_point 0
@ -1519,9 +1529,6 @@ namespace eval punk::du {
#this concept doesn't correspond 1-to-1 with unix links
#https://learn.microsoft.com/en-us/windows/win32/fileio/reparse-points
#review - and see which if any actually belong in the links key of our return
if {$skip_links} {
continue
}
#One thing it could be, is a 'mounted folder' https://learn.microsoft.com/en-us/windows/win32/fileio/determining-whether-a-directory-is-a-volume-mount-point
#
@ -1539,41 +1546,55 @@ namespace eval punk::du {
#
#Note also - a shortcut created in explorer with drag and drop to an existant folder is a different animal to a symlink (file with .lnk extension) even though it looks the same in explorer window.
#
#links are techically files too, whether they point to a file/dir or nothing.
#--------------------------------------
#review
#for consistency with tcl glob - we can't skip - it may point to a file or directory.
#--------------------------------------
if {!$entry_directory} {
#review - other attributes? will we see a link to a link here?
set entry_link_to_file 1
dict set linkdata target_type file
} else {
set entry_link_to_directory 1
dict set linkdata target_type directory
}
lappend links $fullname
#set ftype "l"
set do_sizes $do_sizes_l
set do_times $do_times_l
#review - other attributes? will we see a link to a link here?
#this branch will never be taken as we're currently setting either entry_link_to_file or entry_link_to_directory
#if {$skip_links && !$entry_link_to_directory && !$entry_link_to_file} {
# continue
#}
if {!$skip_links} {
lappend links $fullname
dict set linkdata linktype reparse_point
if {$opt_linkinfo} {
#dict set linkdata reparseinfo [dict get $attrdict -reparseinfo]
dict set linkdata reparseinfo $entry_reparse_info
}
}
if {$entry_directory} {
set do_sizes $do_sizes_l
set do_times $do_times_l
}
if {$skip_dirs && ($entry_directory || $entry_link_to_directory)} {
continue
} elseif {$entry_directory} {
#consider all directories to be executable for now - as this what TCL glob does on windows.
#review - should check ACLS if 'x' type is given, as seems to be done on unix.
if {$skip_dirs} {
continue
}
if {!$entry_reparse_point} {
#if {!$entry_reparse_point} {
lappend dirs $fullname
#set ftype "d"
set do_sizes $do_sizes_d
set do_times $do_times_d
} else {
#other mechanisms can't immediately classify a link as file vs directory - so we don't return this info in the main dirs/files collections
dict set linkdata target_type directory
}
#} else {
# dict set linkdata target_type directory
#}
}
if {!$entry_reparse_point && !$entry_directory} {
if {$entry_link_to_file || (!$entry_reparse_point && !$entry_directory)} {
#review - is anything that isn't a reparse_point or a directory, some sort of 'file' in this context? What about the 'device' attribute? Can that occur in a directory listing of some sort?
if {$skip_files} {
continue
@ -1620,9 +1641,6 @@ namespace eval punk::du {
m [twapi::large_system_time_to_secs_since_1970 [dict get $iteminfo mtime]]\
]
}
#if {[dict size $linkdata]} {
# dict set linkinfo $fullname $linkdata
#}
if {[llength $linkdata]} {
dict set linkinfo $fullname $linkdata
}
@ -1686,14 +1704,17 @@ namespace eval punk::du {
}
return $vfsmounts
}
#work around the horrible tilde-expansion thing (not needed for tcl 9+)
proc file_join_one {base newtail} {
#work around the horrible tilde-expansion thing (not needed for tcl 9+)
#note base could be c: or c:/
# we need to be careful not to introduce extra slashes - file join should already do the right thing.
if {[string index $newtail 0] ne {~}} {
#return [file join $base $newtail]
return $base/$newtail
return [file join $base $newtail]
#return $base/$newtail
}
#return [file join $base ./$newtail]
return $base/./$newtail
return [file join $base ./$newtail]
#return $base/./$newtail
}

7
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/lib-0.1.6.tm

@ -134,8 +134,9 @@ tcl::namespace::eval punk::lib::check {
#These are reported in warning output of 'help tcl' - or used for workarounds in some cases.
proc has_tclbug_caseinsensitiveglob_windows {} {
#https://core.tcl-lang.org/tcl/tktview/108904173c - not accepted
#https://core.tcl-lang.org/tcl/tktview/108904173c
set bug 0 ;#default only
if {"windows" ne $::tcl_platform(platform)} {
set bug 0
} else {
@ -151,10 +152,10 @@ tcl::namespace::eval punk::lib::check {
break
}
}
return [dict create bug $bug bugref 108904173c description "glob with patterns on windows can return inconsistently cased results - apparently by design." level warning]
}
#possibly related anomaly is that a returned result with case that doesn't match that of the file in the underlying filesystem can't be normalized
# to the correct case without doing some sort of string manipulation on the result such as 'string range $f 0 end' to affect the internal representation.
}
return [dict create bug $bug bugref 108904173c description "glob with patterns on windows can return inconsistently cased results" level medium]
}
#todo: it would be nice to test for the other portion of issue 108904173c - that on unix with a mounted case-insensitive filesystem we get other inconsistencies.

110
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm

@ -1651,7 +1651,7 @@ tcl::namespace::eval punk::nav::fs {
#This means accounting for prefixes of valid options and determining if they accept a parameter (which is allowed to begin with a dash) or not.
#Any argument that is in a possible option position and begins with a dash but isn't a valid option (or the -- itself)
#should raise an error rather than being treated as a literal glob pattern.
#set valid_options [list -directory -join -nocomplain -path -tails -types]
set valid_options [list -patterndebug -directory -join -nocomplain -path -tails -types]
#set solo_options [list -nocomplain -join -tails]
set options [dict create] ;#for solos we will set the value to 1, for options that take parameters we will set the value to the parameter
set patterns [list]
@ -1669,9 +1669,9 @@ tcl::namespace::eval punk::nav::fs {
break
}
#flag-like argument before -- we need to check if arg is a valid option or not
set full_option_name [tcl::prefix::match {-directory -join -nocomplain -path -tails -types} $a]
set full_option_name [tcl::prefix::match {-patterndebug -directory -join -nocomplain -path -tails -types} $a]
switch -- $full_option_name {
-directory - -path - -types {
-patterndebug - -directory - -path - -types {
#option takes a parameter - so next arg is parameter even if it looks like an option
if {$j < $arglen} {
dict set options $full_option_name [lindex $args $j]
@ -1681,9 +1681,12 @@ tcl::namespace::eval punk::nav::fs {
error "fglob: option \"$a\" requires a parameter but none found"
}
}
default {
-join - -nocomplain - -tails {
dict set options $full_option_name 1
}
default {
error "fglob: bad option \"$a\": must be a unique prefix of [join $valid_options ", "] or --"
}
}
}
#return [dict create options $options patterns $patterns]
@ -1701,6 +1704,11 @@ tcl::namespace::eval punk::nav::fs {
} else {
set types {}
}
if {[dict exists $options -patterndebug]} {
set opt_patterndebug [dict get $options -patterndebug]
} else {
set opt_patterndebug 0
}
#todo - fix for multiple absolute paths supplied.
#e.g c:/cmdfiles/*.exe c:/repo/jn/shellspy/bin/*.exe
@ -1711,7 +1719,7 @@ tcl::namespace::eval punk::nav::fs {
#It does not seem to sort or de-dup, or group results by type.
set results [list]
foreach pattern $patterns {
set resultd [dirfiles_dict -portabilitycheck 0 -searchbase $basedir -with_times 0 -with_sizes 0 -link_info 0 -types $types -tailglob $pattern]
set resultd [dirfiles_dict -patterndebug $opt_patterndebug -portabilitycheck 0 -searchbase $basedir -with_times 0 -with_sizes 0 -link_info 0 -types $types -tailglob $pattern]
#puts [showdict $resultd]
#todo - other types?
lappend results {*}[dict get $resultd dirs] {*}[dict get $resultd files] {*}[dict get $resultd links]
@ -1809,9 +1817,9 @@ tcl::namespace::eval punk::nav::fs {
foreach fileset [list dirs files links underlayfiles flaggedhidden flaggedreadonly flaggedsystem nonportable vfsmounts] {
set stripped [list]
foreach fullname [set $fileset] {
set shortname [strip_prefix_depth $fullname $common_base]
dict set fkeys $shortname $fullname ;#cache so we can retrieve already normalised name without re-hitting filesystem
lappend stripped $shortname
set base_relative_path [strip_prefix_depth $fullname $common_base]
dict set fkeys $base_relative_path $fullname ;#cache so we can retrieve already normalised name without re-hitting filesystem
lappend stripped $base_relative_path
}
set $fileset $stripped
}
@ -1826,6 +1834,7 @@ tcl::namespace::eval punk::nav::fs {
set file_symlinks [list]
set dir_symlinks [list]
set dir_shortcuts [list] ;#windows shell links (.lnk) that have a target that is a directory
set file_shortcuts [list] ;#windows shell links (.lnk) that have a target that is a file
foreach s $links {
if {[dict exists $contents linkinfo $s target_type]} {
#some mechanisms such as twapi can provide the target_type info so we don't have to re-hit the filesystem.
@ -1836,7 +1845,7 @@ tcl::namespace::eval punk::nav::fs {
}
directory {
lappend dir_symlinks $s
lappend dirs $s
#lappend dirs $s
}
default {
puts stderr "Warning - cannot determine link type for link $s (target_type value is:$target_type)"
@ -1849,7 +1858,7 @@ tcl::namespace::eval punk::nav::fs {
#will be appended in finfo_plus later
} elseif {[file isdirectory $s]} {
lappend dir_symlinks $s
lappend dirs $s
#lappend dirs $s
} else {
#dunno - warn for now
puts stderr "Warning - cannot determine link type for link $s"
@ -1899,23 +1908,7 @@ tcl::namespace::eval punk::nav::fs {
set ts "$key vs [dict keys [dict get $contents times]]"
}
set note ""
lappend finfo [list file $f display "[overtype::left $c2a $f] [overtype::right $c2b $s] [overtype::left $c2c "$ts $note"]"]
}
set flink_style [punk::ansi::a+ undercurly underline undt-green] ;#curly green underline with fallback to normal underline
set dlink_style [punk::ansi::a+ undercurly underline undt-green]
#We use an underline so the visual styling of a link can coexist with fg/bg colors applied for other attributes such as hidden
foreach flink $file_symlinks {
if {[dict size $fkeys]} {
set key [dict get $fkeys $flink]
} else {
set key $flink
}
if {[dict exists $contents times $key m]} {
set mtime [dict get $contents times $key m]
set ts [tcl::clock::format $mtime -format "%Y-%m-%d %H:%M:%S"]
} else {
set ts "[string repeat { } 19]"
}
if {$f in $file_symlinks} {
set note "link" ;#default only
if {[dict exists $contents linkinfo $key linktype]} {
if {[dict get $contents linkinfo $key linktype] eq "reparse_point"} {
@ -1927,9 +1920,41 @@ tcl::namespace::eval punk::nav::fs {
append note "$key vs [dict keys [dict get $contents linkinfo]]"
}
}
lappend finfo [list file $flink display "$flink_style[overtype::left $c2a $flink] [overtype::right $c2b 0] [overtype::left $c2c "$ts $note"]"]
}
lappend finfo [list file $f display "[overtype::left $c2a $f] [overtype::right $c2b $s] [overtype::left $c2c "$ts $note"]"]
}
set flink_style [punk::ansi::a+ undercurly underline undt-green] ;#curly green underline with fallback to normal underline
set dlink_style [punk::ansi::a+ undercurly underline undt-green]
#We use an underline so the visual styling of a link can coexist with fg/bg colors applied for other attributes such as hidden
#review
#foreach flink $file_symlinks {
# if {[dict size $fkeys]} {
# set key [dict get $fkeys $flink]
# } else {
# set key $flink
# }
# if {[dict exists $contents times $key m]} {
# set mtime [dict get $contents times $key m]
# set ts [tcl::clock::format $mtime -format "%Y-%m-%d %H:%M:%S"]
# } else {
# set ts "[string repeat { } 19]"
# }
# set note "link" ;#default only
# if {[dict exists $contents linkinfo $key linktype]} {
# if {[dict get $contents linkinfo $key linktype] eq "reparse_point"} {
# set note "reparse_point"
# if {[dict exists $contents linkinfo $key reparseinfo tag]} {
# append note " " [dict get $contents linkinfo $key reparseinfo tag]
# }
# } else {
# append note "$key vs [dict keys [dict get $contents linkinfo]]"
# }
# }
# lappend finfo [list file $flink display "$flink_style[overtype::left $c2a $flink] [overtype::right $c2b 0] [overtype::left $c2c "$ts $note"]"]
#}
set fshortcut_style [punk::ansi::a+ underdotted underline undt-hotpink]
set dshortcut_style [punk::ansi::a+ underdotted underline undt-hotpink]
#examine windows .lnk shell link files (shortcuts) - these could be encountered on other platforms too - we should still be able to read them
@ -1988,6 +2013,7 @@ tcl::namespace::eval punk::nav::fs {
}
dict set fdict display $display
lappend finfo_plus $fdict
lappend file_shortcuts $fname
}
directory {
#target of link is a dir - for display/categorisation purposes we want to see it as a dir
@ -2064,29 +2090,7 @@ tcl::namespace::eval punk::nav::fs {
#lappend d1_overrides underline undt-red ;#we use underlins to indicate symlinks and shortcuts, so we shouldn't use underlines here if possible.
lappend d1_overrides italic bold
}
#if {$d in $vfsmounts} {
# if {$d in $flaggedhidden} {
# #we could have a hidden dir which is also a vfs.. colour will be overridden giving no indication of 'hidden' status - REVIEW
# #(This situation encountered on windows - even though file attr showed -hidden 0 - the glob with -types hidden returned it.. possibly a tcl glob bug on windows)
# #mark it differently for now.. (todo bug report?)
# if {$d in $nonportable} {
# set d1 [punk::ansi::a+ red Yellow bold]
# } else {
# set d1 [punk::ansi::a+ green Purple bold]
# }
# } else {
# if {$d in $nonportable} {
# set d1 [punk::ansi::a+ red White bold]
# } else {
# set d1 [punk::ansi::a+ green bold]
# }
# }
#} else {
# if {$d in $nonportable} {
# set d1 [punk::ansi::a+ red bold]
# }
#}
#dlink-style & dshortcut_style are for underlines - can be added with colours already set
#dlink_style & dshortcut_style are for underlines - can be added with colours already set
if {[llength $d1_overrides]} {
set d1 [punk::ansi::a+ {*}$d1_overrides]
@ -2111,6 +2115,10 @@ tcl::namespace::eval punk::nav::fs {
if {[llength $f1_overrides]} {
set f1 [punk::ansi::a+ {*}$f1_overrides]
}
if {$fname in $file_symlinks} {
append f1 $flink_style
}
#fshortcut_style already set in the display string for shortcuts targeting files, so we don't need to add it here.
lappend displaylist [overtype::left $col1 $d1$d$RST]$f1$fdisp$RST
} else {
#either there are no files or opt_listing is / = show dirs only (some of which may have actually been files that were links/shortcuts to directories)

23
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl-0.1.2.tm

@ -92,8 +92,27 @@ package require textblock
if {![info exists ::env(SHELL)]} {
set ::env(SHELL) punk86
#we'll follow posix convention of env(SHELL) being set to the absolute path of the shell executable
#reference: https://pubs.opengroup.org/onlinepubs/9799919799/basedefs/V1_chap08.html
#For example if we launch mintty from within punk, it will pick this up and then launch the new mintty with this shell. seems reasonable.
#some terminals launched from within punk will ignore this - but maintain the value: e.g tabby, rio
#others might ignore it but also clear or not pass it e.g wt, wezterm
#terminals that ignore it are presumably using a stored default shell from their own config.
#shell programs such as cmd.exe, powershell.exe seem to maintain the env variable if launched from within punk.
#we will respect the existing env(SHELL) if it is set
#- as that is the standard way to indicate the user's preferred shell - but if it isn't set, we'll set it to the current executable.
#This allows child processes launched from the shell to pick up on the fact they are running in a shell environment, and also allows nested shells to work correctly.
#review - what about the args the current shell was launched with?
set ::env(SHELL) [file normalize [info nameofexecutable]]
}
if {![info exists ::env(TERM)]} {
# tset -r seems to rely on env(TERM) - so this doesn't seem to work
#if {![catch {exec tset -r} result]} {
@ -1429,6 +1448,8 @@ proc repl::repl_handler {inputchan readmore prompt_config} {
set rawmode 0
set original_input_conf [chan configure $inputchan] ;#whether repl is in line or raw mode - we restore the inputchan (stdin) state
if {[dict exists $original_input_conf -inputmode]} {
#review - when terminal is mintty and we switch to raw mode, the change isn't relected in chan configures '-inputmode' why?
if {[dict get $original_input_conf -inputmode] eq "raw"} {
#user or script has apparently put stdin into raw mode - update punk::console::is_raw to match
set rawmode 1

4
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/winlnk-0.1.1.tm

@ -1011,7 +1011,7 @@ tcl::namespace::eval punk::winlnk {
-summary\
"Show information about a .lnk file (windows shortcut)"\
-help\
"Print to stdout the information obtained by parsing the binary data in a windows .lnk file, in a human readable format.
"Return information obtained by parsing the binary data in a windows .lnk file, in a human readable format.
If the .lnk header check fails, then the .lnk file probably isn't really a shortcut file and an error message will be printed."
@values -min 1 -max 1
path -type string -help "Path to the .lnk file to resolve"
@ -1048,7 +1048,7 @@ tcl::namespace::eval punk::winlnk {
append querystring "$field "
}
}
puts "querystring: $querystring"
#puts "querystring: $querystring"
return [punk::lib::showdict $info {*}$querystring]
}
}

2
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.2.1.tm

@ -9387,7 +9387,6 @@ tcl::namespace::eval punk::args {
set chosen $bestmatch
set choice_in_list 1
}
puts ">>>>> chosen: $chosen bestmatch: $bestmatch for c_check: $c_check choices_test: $choices_test allchoices: $allchoices"
} else {
set chosen [tcl::prefix::match -error "" [list {*}[lsort -unique $allchoices] {*}$choiceprefixreservelist] $c_check]
if {$chosen eq "" || $chosen in $choiceprefixreservelist} {
@ -9413,7 +9412,6 @@ tcl::namespace::eval punk::args {
if {$choicemultiple_max != -1 && $choicemultiple_max < 2} {
#single choice allowed per clause-member
if {$is_multiple} {
puts ">>>>> existing:'$existing' element_index:$element_index choice_index:$choice_idx chosen: $chosen"
if {$clause_size == 1} {
#no list wrapping of single element in $dname dict - so don't index into it with element_index
#lset existing $element_index $chosen ;#wrong - test::punk::args test: choice_multiple_with_choiceprefix.

123
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.1.1.tm

@ -87,6 +87,8 @@ namespace eval punk::console {
#Note that windows terminal cooked mode seems to use 8 for interactive use even if set differently
#e.g typing tab characters may still be echoed 8-spaced while writing to stdout my obey the terminal's tab stops.
variable has_twapi 0
variable previous_stty_state_stdin ""
variable previous_stty_state_stdout ""
variable previous_stty_state_stderr ""
@ -565,7 +567,128 @@ namespace eval punk::console {
return done
}
}
namespace eval system {
proc enableRaw_unix {{channel stdin}} {
upvar ::punk::console::previous_stty_state_$channel previous_stty_state_$channel
set sttycmd [auto_execok stty]
if {[set previous_stty_state_$channel] eq ""} {
if {[catch {exec {*}$sttycmd -g <@$channel} previous_stty_state_$channel]} {
set previous_stty_state_$channel ""
}
}
#REVIEW
switch $channel {
stdin {
exec {*}$sttycmd -icanon -echo -isig
}
default {
exec {*}$sttycmd raw -echo <@$channel
}
}
catch {
tsv::set console is_raw 1
}
return [dict create previous [set previous_stty_state_$channel]]
}
proc disableRaw_unix {{channel stdin}} {
upvar ::punk::console::previous_stty_state_$channel previous_stty_state_$channel
set sttycmd [auto_execok stty]
if {[set previous_stty_state_$channel] ne ""} {
exec {*}$sttycmd [set previous_stty_state_$channel]
set previous_stty_state_$channel ""
} else {
#REVIEW
switch $channel {
stdin {
exec {*}$sttycmd icanon echo isig
}
default {
exec {*}$sttycmd -raw echo <@$channel
}
}
}
catch {
tsv::set console is_raw 0
}
return done
}
proc enableRaw_mintty {{channel stdin}} {
#mintty specific enableRaw
upvar ::punk::console::previous_stty_state_$channel previous_stty_state_$channel
set sttycmd [auto_execok stty]
if {[set previous_stty_state_$channel] eq ""} {
if {[catch {exec {*}$sttycmd -g <@$channel} previous_stty_state_$channel]} {
set previous_stty_state_$channel ""
}
}
#REVIEW
switch $channel {
stdin {
exec {*}$sttycmd -icanon -echo -isig
}
default {
exec {*}$sttycmd raw -echo <@$channel
}
}
catch {
tsv::set console is_raw 1
}
#sometimes mintty on windows has -inputmode available - sometimes not
#sometimes mintty seems to need -inputmode to be set manually.
catch {
chan configure stdin -inputmode raw
}
return [dict create previous [set previous_stty_state_$channel]]
}
proc disableRaw_mintty {{channel stdin}} {
#mintty specific disableRaw
upvar ::punk::console::previous_stty_state_$channel previous_stty_state_$channel
set sttycmd [auto_execok stty]
if {[set previous_stty_state_$channel] ne ""} {
exec {*}$sttycmd [set previous_stty_state_$channel]
set previous_stty_state_$channel ""
puts stderr "previous stty state restored"
} else {
#REVIEW
switch $channel {
stdin {
exec {*}$sttycmd icanon echo isig
}
default {
exec {*}$sttycmd -raw echo <@$channel
}
}
}
catch {
tsv::set console is_raw 0
}
#sometimes mintty on windows has -inputmode available - sometimes not
#sometimes mintty seems to need -inputmode to be set manually.
catch {
chan configure stdin -inputmode normal
}
return done
}
}
if {"windows" eq $::tcl_platform(platform) && [info exists ::env(TERM)] && $::env(TERM) eq "mintty"} {
#note - TERM could also be mintty-direct - apparently for use with wsl.
# - we don't use terminfo or termcap here as we try to use ansi device queries etc. Todo - review.
#we seem to be running in mintty on windows - probably without winpty - so we should be able to use stty to set raw mode.
#override the windows enableRaw and disableRaw with the unix versions which use stty - as the twapi versions don't work in this environment.
#git bash uses mintty - but it seems to behave differently to msys mintty launched directly.
proc enableRaw {{channel stdin}} [info body ::punk::console::system::enableRaw_mintty]
proc disableRaw {{channel stdin}} [info body ::punk::console::system::disableRaw_mintty]
}
#review - document and decide granularity required. should we enable/disable more than one at once?
proc enable_mouse {} {
puts -nonewline stdout \x1b\[?1000h

81
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/du-0.1.0.tm

@ -1227,11 +1227,19 @@ namespace eval punk::du {
#only add to seen_entries after we have passed a glob regex check, to avoid marking entries as seen that we haven't actually processed yet.
set seen_entries [dict create]
foreach win_glob $win_glob_list tcl_re $tcl_regex_list {
if {$opt_patterndebug} {
puts stderr ">>>du_dirlisting_twapi winglob: $win_glob"
puts stderr ">>>du_dirlisting_twapi tclre : $tcl_re"
set debugreport ""
foreach win_glob $win_glob_list tcl_re $tcl_regex_list {
append debugreport ">>>du_dirlisting_twapi winglob: $win_glob" \n
append debugreport ">>>du_dirlisting_twapi tclre : $tcl_re" \n
}
append debugreport "------------------------------------" \n
append debugreport ">>>du_dirlisting_twapi folderpath: $folderpath" \n
append debugreport ">>>du_dirlisting_twapi tclglob : $tcl_glob" \n
append debugreport ">>>du_dirlisting_twapi querycount: [llength $win_glob_list]" \n
puts stderr $debugreport
}
foreach win_glob $win_glob_list tcl_re $tcl_regex_list {
#REVIEW! windows api pattern match https://www.red-gate.com/simple-talk/blogs/the-unexpected-behaviour-of-directoryinfo-getfiles-with-three-letter-extensions is .. weird. partly due to 8.3 filenames
#https://www.red-gate.com/simple-talk/blogs/the-unexpected-behaviour-of-directoryinfo-getfiles-with-three-letter-extensions/
@ -1384,6 +1392,8 @@ namespace eval punk::du {
set entry_archive 0
set entry_directory 0
set entry_link_to_file 0
set entry_link_to_directory 0
set entry_hidden 0
set entry_readonly 0
set entry_reparse_point 0
@ -1519,9 +1529,6 @@ namespace eval punk::du {
#this concept doesn't correspond 1-to-1 with unix links
#https://learn.microsoft.com/en-us/windows/win32/fileio/reparse-points
#review - and see which if any actually belong in the links key of our return
if {$skip_links} {
continue
}
#One thing it could be, is a 'mounted folder' https://learn.microsoft.com/en-us/windows/win32/fileio/determining-whether-a-directory-is-a-volume-mount-point
#
@ -1539,41 +1546,55 @@ namespace eval punk::du {
#
#Note also - a shortcut created in explorer with drag and drop to an existant folder is a different animal to a symlink (file with .lnk extension) even though it looks the same in explorer window.
#
#links are techically files too, whether they point to a file/dir or nothing.
#--------------------------------------
#review
#for consistency with tcl glob - we can't skip - it may point to a file or directory.
#--------------------------------------
if {!$entry_directory} {
#review - other attributes? will we see a link to a link here?
set entry_link_to_file 1
dict set linkdata target_type file
} else {
set entry_link_to_directory 1
dict set linkdata target_type directory
}
lappend links $fullname
#set ftype "l"
set do_sizes $do_sizes_l
set do_times $do_times_l
#review - other attributes? will we see a link to a link here?
#this branch will never be taken as we're currently setting either entry_link_to_file or entry_link_to_directory
#if {$skip_links && !$entry_link_to_directory && !$entry_link_to_file} {
# continue
#}
if {!$skip_links} {
lappend links $fullname
dict set linkdata linktype reparse_point
if {$opt_linkinfo} {
#dict set linkdata reparseinfo [dict get $attrdict -reparseinfo]
dict set linkdata reparseinfo $entry_reparse_info
}
}
if {$entry_directory} {
set do_sizes $do_sizes_l
set do_times $do_times_l
}
if {$skip_dirs && ($entry_directory || $entry_link_to_directory)} {
continue
} elseif {$entry_directory} {
#consider all directories to be executable for now - as this what TCL glob does on windows.
#review - should check ACLS if 'x' type is given, as seems to be done on unix.
if {$skip_dirs} {
continue
}
if {!$entry_reparse_point} {
#if {!$entry_reparse_point} {
lappend dirs $fullname
#set ftype "d"
set do_sizes $do_sizes_d
set do_times $do_times_d
} else {
#other mechanisms can't immediately classify a link as file vs directory - so we don't return this info in the main dirs/files collections
dict set linkdata target_type directory
}
#} else {
# dict set linkdata target_type directory
#}
}
if {!$entry_reparse_point && !$entry_directory} {
if {$entry_link_to_file || (!$entry_reparse_point && !$entry_directory)} {
#review - is anything that isn't a reparse_point or a directory, some sort of 'file' in this context? What about the 'device' attribute? Can that occur in a directory listing of some sort?
if {$skip_files} {
continue
@ -1620,9 +1641,6 @@ namespace eval punk::du {
m [twapi::large_system_time_to_secs_since_1970 [dict get $iteminfo mtime]]\
]
}
#if {[dict size $linkdata]} {
# dict set linkinfo $fullname $linkdata
#}
if {[llength $linkdata]} {
dict set linkinfo $fullname $linkdata
}
@ -1686,14 +1704,17 @@ namespace eval punk::du {
}
return $vfsmounts
}
#work around the horrible tilde-expansion thing (not needed for tcl 9+)
proc file_join_one {base newtail} {
#work around the horrible tilde-expansion thing (not needed for tcl 9+)
#note base could be c: or c:/
# we need to be careful not to introduce extra slashes - file join should already do the right thing.
if {[string index $newtail 0] ne {~}} {
#return [file join $base $newtail]
return $base/$newtail
return [file join $base $newtail]
#return $base/$newtail
}
#return [file join $base ./$newtail]
return $base/./$newtail
return [file join $base ./$newtail]
#return $base/./$newtail
}

7
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/lib-0.1.6.tm

@ -134,8 +134,9 @@ tcl::namespace::eval punk::lib::check {
#These are reported in warning output of 'help tcl' - or used for workarounds in some cases.
proc has_tclbug_caseinsensitiveglob_windows {} {
#https://core.tcl-lang.org/tcl/tktview/108904173c - not accepted
#https://core.tcl-lang.org/tcl/tktview/108904173c
set bug 0 ;#default only
if {"windows" ne $::tcl_platform(platform)} {
set bug 0
} else {
@ -151,10 +152,10 @@ tcl::namespace::eval punk::lib::check {
break
}
}
return [dict create bug $bug bugref 108904173c description "glob with patterns on windows can return inconsistently cased results - apparently by design." level warning]
}
#possibly related anomaly is that a returned result with case that doesn't match that of the file in the underlying filesystem can't be normalized
# to the correct case without doing some sort of string manipulation on the result such as 'string range $f 0 end' to affect the internal representation.
}
return [dict create bug $bug bugref 108904173c description "glob with patterns on windows can return inconsistently cased results" level medium]
}
#todo: it would be nice to test for the other portion of issue 108904173c - that on unix with a mounted case-insensitive filesystem we get other inconsistencies.

110
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm

@ -1651,7 +1651,7 @@ tcl::namespace::eval punk::nav::fs {
#This means accounting for prefixes of valid options and determining if they accept a parameter (which is allowed to begin with a dash) or not.
#Any argument that is in a possible option position and begins with a dash but isn't a valid option (or the -- itself)
#should raise an error rather than being treated as a literal glob pattern.
#set valid_options [list -directory -join -nocomplain -path -tails -types]
set valid_options [list -patterndebug -directory -join -nocomplain -path -tails -types]
#set solo_options [list -nocomplain -join -tails]
set options [dict create] ;#for solos we will set the value to 1, for options that take parameters we will set the value to the parameter
set patterns [list]
@ -1669,9 +1669,9 @@ tcl::namespace::eval punk::nav::fs {
break
}
#flag-like argument before -- we need to check if arg is a valid option or not
set full_option_name [tcl::prefix::match {-directory -join -nocomplain -path -tails -types} $a]
set full_option_name [tcl::prefix::match {-patterndebug -directory -join -nocomplain -path -tails -types} $a]
switch -- $full_option_name {
-directory - -path - -types {
-patterndebug - -directory - -path - -types {
#option takes a parameter - so next arg is parameter even if it looks like an option
if {$j < $arglen} {
dict set options $full_option_name [lindex $args $j]
@ -1681,9 +1681,12 @@ tcl::namespace::eval punk::nav::fs {
error "fglob: option \"$a\" requires a parameter but none found"
}
}
default {
-join - -nocomplain - -tails {
dict set options $full_option_name 1
}
default {
error "fglob: bad option \"$a\": must be a unique prefix of [join $valid_options ", "] or --"
}
}
}
#return [dict create options $options patterns $patterns]
@ -1701,6 +1704,11 @@ tcl::namespace::eval punk::nav::fs {
} else {
set types {}
}
if {[dict exists $options -patterndebug]} {
set opt_patterndebug [dict get $options -patterndebug]
} else {
set opt_patterndebug 0
}
#todo - fix for multiple absolute paths supplied.
#e.g c:/cmdfiles/*.exe c:/repo/jn/shellspy/bin/*.exe
@ -1711,7 +1719,7 @@ tcl::namespace::eval punk::nav::fs {
#It does not seem to sort or de-dup, or group results by type.
set results [list]
foreach pattern $patterns {
set resultd [dirfiles_dict -portabilitycheck 0 -searchbase $basedir -with_times 0 -with_sizes 0 -link_info 0 -types $types -tailglob $pattern]
set resultd [dirfiles_dict -patterndebug $opt_patterndebug -portabilitycheck 0 -searchbase $basedir -with_times 0 -with_sizes 0 -link_info 0 -types $types -tailglob $pattern]
#puts [showdict $resultd]
#todo - other types?
lappend results {*}[dict get $resultd dirs] {*}[dict get $resultd files] {*}[dict get $resultd links]
@ -1809,9 +1817,9 @@ tcl::namespace::eval punk::nav::fs {
foreach fileset [list dirs files links underlayfiles flaggedhidden flaggedreadonly flaggedsystem nonportable vfsmounts] {
set stripped [list]
foreach fullname [set $fileset] {
set shortname [strip_prefix_depth $fullname $common_base]
dict set fkeys $shortname $fullname ;#cache so we can retrieve already normalised name without re-hitting filesystem
lappend stripped $shortname
set base_relative_path [strip_prefix_depth $fullname $common_base]
dict set fkeys $base_relative_path $fullname ;#cache so we can retrieve already normalised name without re-hitting filesystem
lappend stripped $base_relative_path
}
set $fileset $stripped
}
@ -1826,6 +1834,7 @@ tcl::namespace::eval punk::nav::fs {
set file_symlinks [list]
set dir_symlinks [list]
set dir_shortcuts [list] ;#windows shell links (.lnk) that have a target that is a directory
set file_shortcuts [list] ;#windows shell links (.lnk) that have a target that is a file
foreach s $links {
if {[dict exists $contents linkinfo $s target_type]} {
#some mechanisms such as twapi can provide the target_type info so we don't have to re-hit the filesystem.
@ -1836,7 +1845,7 @@ tcl::namespace::eval punk::nav::fs {
}
directory {
lappend dir_symlinks $s
lappend dirs $s
#lappend dirs $s
}
default {
puts stderr "Warning - cannot determine link type for link $s (target_type value is:$target_type)"
@ -1849,7 +1858,7 @@ tcl::namespace::eval punk::nav::fs {
#will be appended in finfo_plus later
} elseif {[file isdirectory $s]} {
lappend dir_symlinks $s
lappend dirs $s
#lappend dirs $s
} else {
#dunno - warn for now
puts stderr "Warning - cannot determine link type for link $s"
@ -1899,23 +1908,7 @@ tcl::namespace::eval punk::nav::fs {
set ts "$key vs [dict keys [dict get $contents times]]"
}
set note ""
lappend finfo [list file $f display "[overtype::left $c2a $f] [overtype::right $c2b $s] [overtype::left $c2c "$ts $note"]"]
}
set flink_style [punk::ansi::a+ undercurly underline undt-green] ;#curly green underline with fallback to normal underline
set dlink_style [punk::ansi::a+ undercurly underline undt-green]
#We use an underline so the visual styling of a link can coexist with fg/bg colors applied for other attributes such as hidden
foreach flink $file_symlinks {
if {[dict size $fkeys]} {
set key [dict get $fkeys $flink]
} else {
set key $flink
}
if {[dict exists $contents times $key m]} {
set mtime [dict get $contents times $key m]
set ts [tcl::clock::format $mtime -format "%Y-%m-%d %H:%M:%S"]
} else {
set ts "[string repeat { } 19]"
}
if {$f in $file_symlinks} {
set note "link" ;#default only
if {[dict exists $contents linkinfo $key linktype]} {
if {[dict get $contents linkinfo $key linktype] eq "reparse_point"} {
@ -1927,9 +1920,41 @@ tcl::namespace::eval punk::nav::fs {
append note "$key vs [dict keys [dict get $contents linkinfo]]"
}
}
lappend finfo [list file $flink display "$flink_style[overtype::left $c2a $flink] [overtype::right $c2b 0] [overtype::left $c2c "$ts $note"]"]
}
lappend finfo [list file $f display "[overtype::left $c2a $f] [overtype::right $c2b $s] [overtype::left $c2c "$ts $note"]"]
}
set flink_style [punk::ansi::a+ undercurly underline undt-green] ;#curly green underline with fallback to normal underline
set dlink_style [punk::ansi::a+ undercurly underline undt-green]
#We use an underline so the visual styling of a link can coexist with fg/bg colors applied for other attributes such as hidden
#review
#foreach flink $file_symlinks {
# if {[dict size $fkeys]} {
# set key [dict get $fkeys $flink]
# } else {
# set key $flink
# }
# if {[dict exists $contents times $key m]} {
# set mtime [dict get $contents times $key m]
# set ts [tcl::clock::format $mtime -format "%Y-%m-%d %H:%M:%S"]
# } else {
# set ts "[string repeat { } 19]"
# }
# set note "link" ;#default only
# if {[dict exists $contents linkinfo $key linktype]} {
# if {[dict get $contents linkinfo $key linktype] eq "reparse_point"} {
# set note "reparse_point"
# if {[dict exists $contents linkinfo $key reparseinfo tag]} {
# append note " " [dict get $contents linkinfo $key reparseinfo tag]
# }
# } else {
# append note "$key vs [dict keys [dict get $contents linkinfo]]"
# }
# }
# lappend finfo [list file $flink display "$flink_style[overtype::left $c2a $flink] [overtype::right $c2b 0] [overtype::left $c2c "$ts $note"]"]
#}
set fshortcut_style [punk::ansi::a+ underdotted underline undt-hotpink]
set dshortcut_style [punk::ansi::a+ underdotted underline undt-hotpink]
#examine windows .lnk shell link files (shortcuts) - these could be encountered on other platforms too - we should still be able to read them
@ -1988,6 +2013,7 @@ tcl::namespace::eval punk::nav::fs {
}
dict set fdict display $display
lappend finfo_plus $fdict
lappend file_shortcuts $fname
}
directory {
#target of link is a dir - for display/categorisation purposes we want to see it as a dir
@ -2064,29 +2090,7 @@ tcl::namespace::eval punk::nav::fs {
#lappend d1_overrides underline undt-red ;#we use underlins to indicate symlinks and shortcuts, so we shouldn't use underlines here if possible.
lappend d1_overrides italic bold
}
#if {$d in $vfsmounts} {
# if {$d in $flaggedhidden} {
# #we could have a hidden dir which is also a vfs.. colour will be overridden giving no indication of 'hidden' status - REVIEW
# #(This situation encountered on windows - even though file attr showed -hidden 0 - the glob with -types hidden returned it.. possibly a tcl glob bug on windows)
# #mark it differently for now.. (todo bug report?)
# if {$d in $nonportable} {
# set d1 [punk::ansi::a+ red Yellow bold]
# } else {
# set d1 [punk::ansi::a+ green Purple bold]
# }
# } else {
# if {$d in $nonportable} {
# set d1 [punk::ansi::a+ red White bold]
# } else {
# set d1 [punk::ansi::a+ green bold]
# }
# }
#} else {
# if {$d in $nonportable} {
# set d1 [punk::ansi::a+ red bold]
# }
#}
#dlink-style & dshortcut_style are for underlines - can be added with colours already set
#dlink_style & dshortcut_style are for underlines - can be added with colours already set
if {[llength $d1_overrides]} {
set d1 [punk::ansi::a+ {*}$d1_overrides]
@ -2111,6 +2115,10 @@ tcl::namespace::eval punk::nav::fs {
if {[llength $f1_overrides]} {
set f1 [punk::ansi::a+ {*}$f1_overrides]
}
if {$fname in $file_symlinks} {
append f1 $flink_style
}
#fshortcut_style already set in the display string for shortcuts targeting files, so we don't need to add it here.
lappend displaylist [overtype::left $col1 $d1$d$RST]$f1$fdisp$RST
} else {
#either there are no files or opt_listing is / = show dirs only (some of which may have actually been files that were links/shortcuts to directories)

23
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl-0.1.2.tm

@ -92,8 +92,27 @@ package require textblock
if {![info exists ::env(SHELL)]} {
set ::env(SHELL) punk86
#we'll follow posix convention of env(SHELL) being set to the absolute path of the shell executable
#reference: https://pubs.opengroup.org/onlinepubs/9799919799/basedefs/V1_chap08.html
#For example if we launch mintty from within punk, it will pick this up and then launch the new mintty with this shell. seems reasonable.
#some terminals launched from within punk will ignore this - but maintain the value: e.g tabby, rio
#others might ignore it but also clear or not pass it e.g wt, wezterm
#terminals that ignore it are presumably using a stored default shell from their own config.
#shell programs such as cmd.exe, powershell.exe seem to maintain the env variable if launched from within punk.
#we will respect the existing env(SHELL) if it is set
#- as that is the standard way to indicate the user's preferred shell - but if it isn't set, we'll set it to the current executable.
#This allows child processes launched from the shell to pick up on the fact they are running in a shell environment, and also allows nested shells to work correctly.
#review - what about the args the current shell was launched with?
set ::env(SHELL) [file normalize [info nameofexecutable]]
}
if {![info exists ::env(TERM)]} {
# tset -r seems to rely on env(TERM) - so this doesn't seem to work
#if {![catch {exec tset -r} result]} {
@ -1429,6 +1448,8 @@ proc repl::repl_handler {inputchan readmore prompt_config} {
set rawmode 0
set original_input_conf [chan configure $inputchan] ;#whether repl is in line or raw mode - we restore the inputchan (stdin) state
if {[dict exists $original_input_conf -inputmode]} {
#review - when terminal is mintty and we switch to raw mode, the change isn't relected in chan configures '-inputmode' why?
if {[dict get $original_input_conf -inputmode] eq "raw"} {
#user or script has apparently put stdin into raw mode - update punk::console::is_raw to match
set rawmode 1

4
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/winlnk-0.1.1.tm

@ -1011,7 +1011,7 @@ tcl::namespace::eval punk::winlnk {
-summary\
"Show information about a .lnk file (windows shortcut)"\
-help\
"Print to stdout the information obtained by parsing the binary data in a windows .lnk file, in a human readable format.
"Return information obtained by parsing the binary data in a windows .lnk file, in a human readable format.
If the .lnk header check fails, then the .lnk file probably isn't really a shortcut file and an error message will be printed."
@values -min 1 -max 1
path -type string -help "Path to the .lnk file to resolve"
@ -1048,7 +1048,7 @@ tcl::namespace::eval punk::winlnk {
append querystring "$field "
}
}
puts "querystring: $querystring"
#puts "querystring: $querystring"
return [punk::lib::showdict $info {*}$querystring]
}
}

2
src/vfs/_vfscommon.vfs/modules/punk/args-0.2.1.tm

@ -9387,7 +9387,6 @@ tcl::namespace::eval punk::args {
set chosen $bestmatch
set choice_in_list 1
}
puts ">>>>> chosen: $chosen bestmatch: $bestmatch for c_check: $c_check choices_test: $choices_test allchoices: $allchoices"
} else {
set chosen [tcl::prefix::match -error "" [list {*}[lsort -unique $allchoices] {*}$choiceprefixreservelist] $c_check]
if {$chosen eq "" || $chosen in $choiceprefixreservelist} {
@ -9413,7 +9412,6 @@ tcl::namespace::eval punk::args {
if {$choicemultiple_max != -1 && $choicemultiple_max < 2} {
#single choice allowed per clause-member
if {$is_multiple} {
puts ">>>>> existing:'$existing' element_index:$element_index choice_index:$choice_idx chosen: $chosen"
if {$clause_size == 1} {
#no list wrapping of single element in $dname dict - so don't index into it with element_index
#lset existing $element_index $chosen ;#wrong - test::punk::args test: choice_multiple_with_choiceprefix.

123
src/vfs/_vfscommon.vfs/modules/punk/console-0.1.1.tm

@ -87,6 +87,8 @@ namespace eval punk::console {
#Note that windows terminal cooked mode seems to use 8 for interactive use even if set differently
#e.g typing tab characters may still be echoed 8-spaced while writing to stdout my obey the terminal's tab stops.
variable has_twapi 0
variable previous_stty_state_stdin ""
variable previous_stty_state_stdout ""
variable previous_stty_state_stderr ""
@ -565,7 +567,128 @@ namespace eval punk::console {
return done
}
}
namespace eval system {
proc enableRaw_unix {{channel stdin}} {
upvar ::punk::console::previous_stty_state_$channel previous_stty_state_$channel
set sttycmd [auto_execok stty]
if {[set previous_stty_state_$channel] eq ""} {
if {[catch {exec {*}$sttycmd -g <@$channel} previous_stty_state_$channel]} {
set previous_stty_state_$channel ""
}
}
#REVIEW
switch $channel {
stdin {
exec {*}$sttycmd -icanon -echo -isig
}
default {
exec {*}$sttycmd raw -echo <@$channel
}
}
catch {
tsv::set console is_raw 1
}
return [dict create previous [set previous_stty_state_$channel]]
}
proc disableRaw_unix {{channel stdin}} {
upvar ::punk::console::previous_stty_state_$channel previous_stty_state_$channel
set sttycmd [auto_execok stty]
if {[set previous_stty_state_$channel] ne ""} {
exec {*}$sttycmd [set previous_stty_state_$channel]
set previous_stty_state_$channel ""
} else {
#REVIEW
switch $channel {
stdin {
exec {*}$sttycmd icanon echo isig
}
default {
exec {*}$sttycmd -raw echo <@$channel
}
}
}
catch {
tsv::set console is_raw 0
}
return done
}
proc enableRaw_mintty {{channel stdin}} {
#mintty specific enableRaw
upvar ::punk::console::previous_stty_state_$channel previous_stty_state_$channel
set sttycmd [auto_execok stty]
if {[set previous_stty_state_$channel] eq ""} {
if {[catch {exec {*}$sttycmd -g <@$channel} previous_stty_state_$channel]} {
set previous_stty_state_$channel ""
}
}
#REVIEW
switch $channel {
stdin {
exec {*}$sttycmd -icanon -echo -isig
}
default {
exec {*}$sttycmd raw -echo <@$channel
}
}
catch {
tsv::set console is_raw 1
}
#sometimes mintty on windows has -inputmode available - sometimes not
#sometimes mintty seems to need -inputmode to be set manually.
catch {
chan configure stdin -inputmode raw
}
return [dict create previous [set previous_stty_state_$channel]]
}
proc disableRaw_mintty {{channel stdin}} {
#mintty specific disableRaw
upvar ::punk::console::previous_stty_state_$channel previous_stty_state_$channel
set sttycmd [auto_execok stty]
if {[set previous_stty_state_$channel] ne ""} {
exec {*}$sttycmd [set previous_stty_state_$channel]
set previous_stty_state_$channel ""
puts stderr "previous stty state restored"
} else {
#REVIEW
switch $channel {
stdin {
exec {*}$sttycmd icanon echo isig
}
default {
exec {*}$sttycmd -raw echo <@$channel
}
}
}
catch {
tsv::set console is_raw 0
}
#sometimes mintty on windows has -inputmode available - sometimes not
#sometimes mintty seems to need -inputmode to be set manually.
catch {
chan configure stdin -inputmode normal
}
return done
}
}
if {"windows" eq $::tcl_platform(platform) && [info exists ::env(TERM)] && $::env(TERM) eq "mintty"} {
#note - TERM could also be mintty-direct - apparently for use with wsl.
# - we don't use terminfo or termcap here as we try to use ansi device queries etc. Todo - review.
#we seem to be running in mintty on windows - probably without winpty - so we should be able to use stty to set raw mode.
#override the windows enableRaw and disableRaw with the unix versions which use stty - as the twapi versions don't work in this environment.
#git bash uses mintty - but it seems to behave differently to msys mintty launched directly.
proc enableRaw {{channel stdin}} [info body ::punk::console::system::enableRaw_mintty]
proc disableRaw {{channel stdin}} [info body ::punk::console::system::disableRaw_mintty]
}
#review - document and decide granularity required. should we enable/disable more than one at once?
proc enable_mouse {} {
puts -nonewline stdout \x1b\[?1000h

81
src/vfs/_vfscommon.vfs/modules/punk/du-0.1.0.tm

@ -1227,11 +1227,19 @@ namespace eval punk::du {
#only add to seen_entries after we have passed a glob regex check, to avoid marking entries as seen that we haven't actually processed yet.
set seen_entries [dict create]
foreach win_glob $win_glob_list tcl_re $tcl_regex_list {
if {$opt_patterndebug} {
puts stderr ">>>du_dirlisting_twapi winglob: $win_glob"
puts stderr ">>>du_dirlisting_twapi tclre : $tcl_re"
set debugreport ""
foreach win_glob $win_glob_list tcl_re $tcl_regex_list {
append debugreport ">>>du_dirlisting_twapi winglob: $win_glob" \n
append debugreport ">>>du_dirlisting_twapi tclre : $tcl_re" \n
}
append debugreport "------------------------------------" \n
append debugreport ">>>du_dirlisting_twapi folderpath: $folderpath" \n
append debugreport ">>>du_dirlisting_twapi tclglob : $tcl_glob" \n
append debugreport ">>>du_dirlisting_twapi querycount: [llength $win_glob_list]" \n
puts stderr $debugreport
}
foreach win_glob $win_glob_list tcl_re $tcl_regex_list {
#REVIEW! windows api pattern match https://www.red-gate.com/simple-talk/blogs/the-unexpected-behaviour-of-directoryinfo-getfiles-with-three-letter-extensions is .. weird. partly due to 8.3 filenames
#https://www.red-gate.com/simple-talk/blogs/the-unexpected-behaviour-of-directoryinfo-getfiles-with-three-letter-extensions/
@ -1384,6 +1392,8 @@ namespace eval punk::du {
set entry_archive 0
set entry_directory 0
set entry_link_to_file 0
set entry_link_to_directory 0
set entry_hidden 0
set entry_readonly 0
set entry_reparse_point 0
@ -1519,9 +1529,6 @@ namespace eval punk::du {
#this concept doesn't correspond 1-to-1 with unix links
#https://learn.microsoft.com/en-us/windows/win32/fileio/reparse-points
#review - and see which if any actually belong in the links key of our return
if {$skip_links} {
continue
}
#One thing it could be, is a 'mounted folder' https://learn.microsoft.com/en-us/windows/win32/fileio/determining-whether-a-directory-is-a-volume-mount-point
#
@ -1539,41 +1546,55 @@ namespace eval punk::du {
#
#Note also - a shortcut created in explorer with drag and drop to an existant folder is a different animal to a symlink (file with .lnk extension) even though it looks the same in explorer window.
#
#links are techically files too, whether they point to a file/dir or nothing.
#--------------------------------------
#review
#for consistency with tcl glob - we can't skip - it may point to a file or directory.
#--------------------------------------
if {!$entry_directory} {
#review - other attributes? will we see a link to a link here?
set entry_link_to_file 1
dict set linkdata target_type file
} else {
set entry_link_to_directory 1
dict set linkdata target_type directory
}
lappend links $fullname
#set ftype "l"
set do_sizes $do_sizes_l
set do_times $do_times_l
#review - other attributes? will we see a link to a link here?
#this branch will never be taken as we're currently setting either entry_link_to_file or entry_link_to_directory
#if {$skip_links && !$entry_link_to_directory && !$entry_link_to_file} {
# continue
#}
if {!$skip_links} {
lappend links $fullname
dict set linkdata linktype reparse_point
if {$opt_linkinfo} {
#dict set linkdata reparseinfo [dict get $attrdict -reparseinfo]
dict set linkdata reparseinfo $entry_reparse_info
}
}
if {$entry_directory} {
set do_sizes $do_sizes_l
set do_times $do_times_l
}
if {$skip_dirs && ($entry_directory || $entry_link_to_directory)} {
continue
} elseif {$entry_directory} {
#consider all directories to be executable for now - as this what TCL glob does on windows.
#review - should check ACLS if 'x' type is given, as seems to be done on unix.
if {$skip_dirs} {
continue
}
if {!$entry_reparse_point} {
#if {!$entry_reparse_point} {
lappend dirs $fullname
#set ftype "d"
set do_sizes $do_sizes_d
set do_times $do_times_d
} else {
#other mechanisms can't immediately classify a link as file vs directory - so we don't return this info in the main dirs/files collections
dict set linkdata target_type directory
}
#} else {
# dict set linkdata target_type directory
#}
}
if {!$entry_reparse_point && !$entry_directory} {
if {$entry_link_to_file || (!$entry_reparse_point && !$entry_directory)} {
#review - is anything that isn't a reparse_point or a directory, some sort of 'file' in this context? What about the 'device' attribute? Can that occur in a directory listing of some sort?
if {$skip_files} {
continue
@ -1620,9 +1641,6 @@ namespace eval punk::du {
m [twapi::large_system_time_to_secs_since_1970 [dict get $iteminfo mtime]]\
]
}
#if {[dict size $linkdata]} {
# dict set linkinfo $fullname $linkdata
#}
if {[llength $linkdata]} {
dict set linkinfo $fullname $linkdata
}
@ -1686,14 +1704,17 @@ namespace eval punk::du {
}
return $vfsmounts
}
#work around the horrible tilde-expansion thing (not needed for tcl 9+)
proc file_join_one {base newtail} {
#work around the horrible tilde-expansion thing (not needed for tcl 9+)
#note base could be c: or c:/
# we need to be careful not to introduce extra slashes - file join should already do the right thing.
if {[string index $newtail 0] ne {~}} {
#return [file join $base $newtail]
return $base/$newtail
return [file join $base $newtail]
#return $base/$newtail
}
#return [file join $base ./$newtail]
return $base/./$newtail
return [file join $base ./$newtail]
#return $base/./$newtail
}

7
src/vfs/_vfscommon.vfs/modules/punk/lib-0.1.6.tm

@ -134,8 +134,9 @@ tcl::namespace::eval punk::lib::check {
#These are reported in warning output of 'help tcl' - or used for workarounds in some cases.
proc has_tclbug_caseinsensitiveglob_windows {} {
#https://core.tcl-lang.org/tcl/tktview/108904173c - not accepted
#https://core.tcl-lang.org/tcl/tktview/108904173c
set bug 0 ;#default only
if {"windows" ne $::tcl_platform(platform)} {
set bug 0
} else {
@ -151,10 +152,10 @@ tcl::namespace::eval punk::lib::check {
break
}
}
return [dict create bug $bug bugref 108904173c description "glob with patterns on windows can return inconsistently cased results - apparently by design." level warning]
}
#possibly related anomaly is that a returned result with case that doesn't match that of the file in the underlying filesystem can't be normalized
# to the correct case without doing some sort of string manipulation on the result such as 'string range $f 0 end' to affect the internal representation.
}
return [dict create bug $bug bugref 108904173c description "glob with patterns on windows can return inconsistently cased results" level medium]
}
#todo: it would be nice to test for the other portion of issue 108904173c - that on unix with a mounted case-insensitive filesystem we get other inconsistencies.

110
src/vfs/_vfscommon.vfs/modules/punk/nav/fs-0.1.0.tm

@ -1651,7 +1651,7 @@ tcl::namespace::eval punk::nav::fs {
#This means accounting for prefixes of valid options and determining if they accept a parameter (which is allowed to begin with a dash) or not.
#Any argument that is in a possible option position and begins with a dash but isn't a valid option (or the -- itself)
#should raise an error rather than being treated as a literal glob pattern.
#set valid_options [list -directory -join -nocomplain -path -tails -types]
set valid_options [list -patterndebug -directory -join -nocomplain -path -tails -types]
#set solo_options [list -nocomplain -join -tails]
set options [dict create] ;#for solos we will set the value to 1, for options that take parameters we will set the value to the parameter
set patterns [list]
@ -1669,9 +1669,9 @@ tcl::namespace::eval punk::nav::fs {
break
}
#flag-like argument before -- we need to check if arg is a valid option or not
set full_option_name [tcl::prefix::match {-directory -join -nocomplain -path -tails -types} $a]
set full_option_name [tcl::prefix::match {-patterndebug -directory -join -nocomplain -path -tails -types} $a]
switch -- $full_option_name {
-directory - -path - -types {
-patterndebug - -directory - -path - -types {
#option takes a parameter - so next arg is parameter even if it looks like an option
if {$j < $arglen} {
dict set options $full_option_name [lindex $args $j]
@ -1681,9 +1681,12 @@ tcl::namespace::eval punk::nav::fs {
error "fglob: option \"$a\" requires a parameter but none found"
}
}
default {
-join - -nocomplain - -tails {
dict set options $full_option_name 1
}
default {
error "fglob: bad option \"$a\": must be a unique prefix of [join $valid_options ", "] or --"
}
}
}
#return [dict create options $options patterns $patterns]
@ -1701,6 +1704,11 @@ tcl::namespace::eval punk::nav::fs {
} else {
set types {}
}
if {[dict exists $options -patterndebug]} {
set opt_patterndebug [dict get $options -patterndebug]
} else {
set opt_patterndebug 0
}
#todo - fix for multiple absolute paths supplied.
#e.g c:/cmdfiles/*.exe c:/repo/jn/shellspy/bin/*.exe
@ -1711,7 +1719,7 @@ tcl::namespace::eval punk::nav::fs {
#It does not seem to sort or de-dup, or group results by type.
set results [list]
foreach pattern $patterns {
set resultd [dirfiles_dict -portabilitycheck 0 -searchbase $basedir -with_times 0 -with_sizes 0 -link_info 0 -types $types -tailglob $pattern]
set resultd [dirfiles_dict -patterndebug $opt_patterndebug -portabilitycheck 0 -searchbase $basedir -with_times 0 -with_sizes 0 -link_info 0 -types $types -tailglob $pattern]
#puts [showdict $resultd]
#todo - other types?
lappend results {*}[dict get $resultd dirs] {*}[dict get $resultd files] {*}[dict get $resultd links]
@ -1809,9 +1817,9 @@ tcl::namespace::eval punk::nav::fs {
foreach fileset [list dirs files links underlayfiles flaggedhidden flaggedreadonly flaggedsystem nonportable vfsmounts] {
set stripped [list]
foreach fullname [set $fileset] {
set shortname [strip_prefix_depth $fullname $common_base]
dict set fkeys $shortname $fullname ;#cache so we can retrieve already normalised name without re-hitting filesystem
lappend stripped $shortname
set base_relative_path [strip_prefix_depth $fullname $common_base]
dict set fkeys $base_relative_path $fullname ;#cache so we can retrieve already normalised name without re-hitting filesystem
lappend stripped $base_relative_path
}
set $fileset $stripped
}
@ -1826,6 +1834,7 @@ tcl::namespace::eval punk::nav::fs {
set file_symlinks [list]
set dir_symlinks [list]
set dir_shortcuts [list] ;#windows shell links (.lnk) that have a target that is a directory
set file_shortcuts [list] ;#windows shell links (.lnk) that have a target that is a file
foreach s $links {
if {[dict exists $contents linkinfo $s target_type]} {
#some mechanisms such as twapi can provide the target_type info so we don't have to re-hit the filesystem.
@ -1836,7 +1845,7 @@ tcl::namespace::eval punk::nav::fs {
}
directory {
lappend dir_symlinks $s
lappend dirs $s
#lappend dirs $s
}
default {
puts stderr "Warning - cannot determine link type for link $s (target_type value is:$target_type)"
@ -1849,7 +1858,7 @@ tcl::namespace::eval punk::nav::fs {
#will be appended in finfo_plus later
} elseif {[file isdirectory $s]} {
lappend dir_symlinks $s
lappend dirs $s
#lappend dirs $s
} else {
#dunno - warn for now
puts stderr "Warning - cannot determine link type for link $s"
@ -1899,23 +1908,7 @@ tcl::namespace::eval punk::nav::fs {
set ts "$key vs [dict keys [dict get $contents times]]"
}
set note ""
lappend finfo [list file $f display "[overtype::left $c2a $f] [overtype::right $c2b $s] [overtype::left $c2c "$ts $note"]"]
}
set flink_style [punk::ansi::a+ undercurly underline undt-green] ;#curly green underline with fallback to normal underline
set dlink_style [punk::ansi::a+ undercurly underline undt-green]
#We use an underline so the visual styling of a link can coexist with fg/bg colors applied for other attributes such as hidden
foreach flink $file_symlinks {
if {[dict size $fkeys]} {
set key [dict get $fkeys $flink]
} else {
set key $flink
}
if {[dict exists $contents times $key m]} {
set mtime [dict get $contents times $key m]
set ts [tcl::clock::format $mtime -format "%Y-%m-%d %H:%M:%S"]
} else {
set ts "[string repeat { } 19]"
}
if {$f in $file_symlinks} {
set note "link" ;#default only
if {[dict exists $contents linkinfo $key linktype]} {
if {[dict get $contents linkinfo $key linktype] eq "reparse_point"} {
@ -1927,9 +1920,41 @@ tcl::namespace::eval punk::nav::fs {
append note "$key vs [dict keys [dict get $contents linkinfo]]"
}
}
lappend finfo [list file $flink display "$flink_style[overtype::left $c2a $flink] [overtype::right $c2b 0] [overtype::left $c2c "$ts $note"]"]
}
lappend finfo [list file $f display "[overtype::left $c2a $f] [overtype::right $c2b $s] [overtype::left $c2c "$ts $note"]"]
}
set flink_style [punk::ansi::a+ undercurly underline undt-green] ;#curly green underline with fallback to normal underline
set dlink_style [punk::ansi::a+ undercurly underline undt-green]
#We use an underline so the visual styling of a link can coexist with fg/bg colors applied for other attributes such as hidden
#review
#foreach flink $file_symlinks {
# if {[dict size $fkeys]} {
# set key [dict get $fkeys $flink]
# } else {
# set key $flink
# }
# if {[dict exists $contents times $key m]} {
# set mtime [dict get $contents times $key m]
# set ts [tcl::clock::format $mtime -format "%Y-%m-%d %H:%M:%S"]
# } else {
# set ts "[string repeat { } 19]"
# }
# set note "link" ;#default only
# if {[dict exists $contents linkinfo $key linktype]} {
# if {[dict get $contents linkinfo $key linktype] eq "reparse_point"} {
# set note "reparse_point"
# if {[dict exists $contents linkinfo $key reparseinfo tag]} {
# append note " " [dict get $contents linkinfo $key reparseinfo tag]
# }
# } else {
# append note "$key vs [dict keys [dict get $contents linkinfo]]"
# }
# }
# lappend finfo [list file $flink display "$flink_style[overtype::left $c2a $flink] [overtype::right $c2b 0] [overtype::left $c2c "$ts $note"]"]
#}
set fshortcut_style [punk::ansi::a+ underdotted underline undt-hotpink]
set dshortcut_style [punk::ansi::a+ underdotted underline undt-hotpink]
#examine windows .lnk shell link files (shortcuts) - these could be encountered on other platforms too - we should still be able to read them
@ -1988,6 +2013,7 @@ tcl::namespace::eval punk::nav::fs {
}
dict set fdict display $display
lappend finfo_plus $fdict
lappend file_shortcuts $fname
}
directory {
#target of link is a dir - for display/categorisation purposes we want to see it as a dir
@ -2064,29 +2090,7 @@ tcl::namespace::eval punk::nav::fs {
#lappend d1_overrides underline undt-red ;#we use underlins to indicate symlinks and shortcuts, so we shouldn't use underlines here if possible.
lappend d1_overrides italic bold
}
#if {$d in $vfsmounts} {
# if {$d in $flaggedhidden} {
# #we could have a hidden dir which is also a vfs.. colour will be overridden giving no indication of 'hidden' status - REVIEW
# #(This situation encountered on windows - even though file attr showed -hidden 0 - the glob with -types hidden returned it.. possibly a tcl glob bug on windows)
# #mark it differently for now.. (todo bug report?)
# if {$d in $nonportable} {
# set d1 [punk::ansi::a+ red Yellow bold]
# } else {
# set d1 [punk::ansi::a+ green Purple bold]
# }
# } else {
# if {$d in $nonportable} {
# set d1 [punk::ansi::a+ red White bold]
# } else {
# set d1 [punk::ansi::a+ green bold]
# }
# }
#} else {
# if {$d in $nonportable} {
# set d1 [punk::ansi::a+ red bold]
# }
#}
#dlink-style & dshortcut_style are for underlines - can be added with colours already set
#dlink_style & dshortcut_style are for underlines - can be added with colours already set
if {[llength $d1_overrides]} {
set d1 [punk::ansi::a+ {*}$d1_overrides]
@ -2111,6 +2115,10 @@ tcl::namespace::eval punk::nav::fs {
if {[llength $f1_overrides]} {
set f1 [punk::ansi::a+ {*}$f1_overrides]
}
if {$fname in $file_symlinks} {
append f1 $flink_style
}
#fshortcut_style already set in the display string for shortcuts targeting files, so we don't need to add it here.
lappend displaylist [overtype::left $col1 $d1$d$RST]$f1$fdisp$RST
} else {
#either there are no files or opt_listing is / = show dirs only (some of which may have actually been files that were links/shortcuts to directories)

23
src/vfs/_vfscommon.vfs/modules/punk/repl-0.1.2.tm

@ -92,8 +92,27 @@ package require textblock
if {![info exists ::env(SHELL)]} {
set ::env(SHELL) punk86
#we'll follow posix convention of env(SHELL) being set to the absolute path of the shell executable
#reference: https://pubs.opengroup.org/onlinepubs/9799919799/basedefs/V1_chap08.html
#For example if we launch mintty from within punk, it will pick this up and then launch the new mintty with this shell. seems reasonable.
#some terminals launched from within punk will ignore this - but maintain the value: e.g tabby, rio
#others might ignore it but also clear or not pass it e.g wt, wezterm
#terminals that ignore it are presumably using a stored default shell from their own config.
#shell programs such as cmd.exe, powershell.exe seem to maintain the env variable if launched from within punk.
#we will respect the existing env(SHELL) if it is set
#- as that is the standard way to indicate the user's preferred shell - but if it isn't set, we'll set it to the current executable.
#This allows child processes launched from the shell to pick up on the fact they are running in a shell environment, and also allows nested shells to work correctly.
#review - what about the args the current shell was launched with?
set ::env(SHELL) [file normalize [info nameofexecutable]]
}
if {![info exists ::env(TERM)]} {
# tset -r seems to rely on env(TERM) - so this doesn't seem to work
#if {![catch {exec tset -r} result]} {
@ -1429,6 +1448,8 @@ proc repl::repl_handler {inputchan readmore prompt_config} {
set rawmode 0
set original_input_conf [chan configure $inputchan] ;#whether repl is in line or raw mode - we restore the inputchan (stdin) state
if {[dict exists $original_input_conf -inputmode]} {
#review - when terminal is mintty and we switch to raw mode, the change isn't relected in chan configures '-inputmode' why?
if {[dict get $original_input_conf -inputmode] eq "raw"} {
#user or script has apparently put stdin into raw mode - update punk::console::is_raw to match
set rawmode 1

4
src/vfs/_vfscommon.vfs/modules/punk/winlnk-0.1.1.tm

@ -1011,7 +1011,7 @@ tcl::namespace::eval punk::winlnk {
-summary\
"Show information about a .lnk file (windows shortcut)"\
-help\
"Print to stdout the information obtained by parsing the binary data in a windows .lnk file, in a human readable format.
"Return information obtained by parsing the binary data in a windows .lnk file, in a human readable format.
If the .lnk header check fails, then the .lnk file probably isn't really a shortcut file and an error message will be printed."
@values -min 1 -max 1
path -type string -help "Path to the .lnk file to resolve"
@ -1048,7 +1048,7 @@ tcl::namespace::eval punk::winlnk {
append querystring "$field "
}
}
puts "querystring: $querystring"
#puts "querystring: $querystring"
return [punk::lib::showdict $info {*}$querystring]
}
}

Loading…
Cancel
Save