diff --git a/src/bootsupport/modules/punk/args-0.2.1.tm b/src/bootsupport/modules/punk/args-0.2.1.tm index cb6f796b..d2ed8045 100644 --- a/src/bootsupport/modules/punk/args-0.2.1.tm +++ b/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. diff --git a/src/bootsupport/modules/punk/console-0.1.1.tm b/src/bootsupport/modules/punk/console-0.1.1.tm index c64720d2..750e6518 100644 --- a/src/bootsupport/modules/punk/console-0.1.1.tm +++ b/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 diff --git a/src/bootsupport/modules/punk/du-0.1.0.tm b/src/bootsupport/modules/punk/du-0.1.0.tm index ad27135d..1ebad3f0 100644 --- a/src/bootsupport/modules/punk/du-0.1.0.tm +++ b/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] + if {$opt_patterndebug} { + 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 { - if {$opt_patterndebug} { - puts stderr ">>>du_dirlisting_twapi winglob: $win_glob" - puts stderr ">>>du_dirlisting_twapi tclre : $tcl_re" - } #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" + #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 + } + } set do_sizes $do_sizes_l set do_times $do_times_l - - 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} { - #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 {$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 {!$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 } diff --git a/src/bootsupport/modules/punk/lib-0.1.6.tm b/src/bootsupport/modules/punk/lib-0.1.6.tm index fe8cfc7e..08e870eb 100644 --- a/src/bootsupport/modules/punk/lib-0.1.6.tm +++ b/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. } + #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. diff --git a/src/bootsupport/modules/punk/nav/fs-0.1.0.tm b/src/bootsupport/modules/punk/nav/fs-0.1.0.tm index 6d877c5f..729d0ffb 100644 --- a/src/bootsupport/modules/punk/nav/fs-0.1.0.tm +++ b/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,36 +1908,52 @@ tcl::namespace::eval punk::nav::fs { set ts "$key vs [dict keys [dict get $contents times]]" } set note "" + 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"} { + 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 $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]" - } - 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"]"] - } + + #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] @@ -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) diff --git a/src/bootsupport/modules/punk/repl-0.1.2.tm b/src/bootsupport/modules/punk/repl-0.1.2.tm index 486720e8..73e5c925 100644 --- a/src/bootsupport/modules/punk/repl-0.1.2.tm +++ b/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 diff --git a/src/bootsupport/modules/punk/winlnk-0.1.1.tm b/src/bootsupport/modules/punk/winlnk-0.1.1.tm index 6c31f56a..ee70e368 100644 --- a/src/bootsupport/modules/punk/winlnk-0.1.1.tm +++ b/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] } } diff --git a/src/modules/punk/args-999999.0a1.0.tm b/src/modules/punk/args-999999.0a1.0.tm index 7e8715eb..392727bc 100644 --- a/src/modules/punk/args-999999.0a1.0.tm +++ b/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. diff --git a/src/modules/punk/console-999999.0a1.0.tm b/src/modules/punk/console-999999.0a1.0.tm index ed881786..e28f2180 100644 --- a/src/modules/punk/console-999999.0a1.0.tm +++ b/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 diff --git a/src/modules/punk/du-999999.0a1.0.tm b/src/modules/punk/du-999999.0a1.0.tm index 71aa9090..8532deea 100644 --- a/src/modules/punk/du-999999.0a1.0.tm +++ b/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] + if {$opt_patterndebug} { + 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 { - if {$opt_patterndebug} { - puts stderr ">>>du_dirlisting_twapi winglob: $win_glob" - puts stderr ">>>du_dirlisting_twapi tclre : $tcl_re" - } #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" + #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 + } + } set do_sizes $do_sizes_l set do_times $do_times_l - - 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} { - #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 {$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 {!$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 } diff --git a/src/modules/punk/lib-999999.0a1.0.tm b/src/modules/punk/lib-999999.0a1.0.tm index c6e2c636..a46d1be6 100644 --- a/src/modules/punk/lib-999999.0a1.0.tm +++ b/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. } + #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. diff --git a/src/modules/punk/nav/fs-999999.0a1.0.tm b/src/modules/punk/nav/fs-999999.0a1.0.tm index 78098df7..ccbd0f32 100644 --- a/src/modules/punk/nav/fs-999999.0a1.0.tm +++ b/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,36 +1908,52 @@ tcl::namespace::eval punk::nav::fs { set ts "$key vs [dict keys [dict get $contents times]]" } set note "" + 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"} { + 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 $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]" - } - 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"]"] - } + + #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] @@ -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) diff --git a/src/modules/punk/repl-999999.0a1.0.tm b/src/modules/punk/repl-999999.0a1.0.tm index efe4b7dd..3345d607 100644 --- a/src/modules/punk/repl-999999.0a1.0.tm +++ b/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 diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.2.1.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.2.1.tm index cb6f796b..d2ed8045 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.2.1.tm +++ b/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. diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.1.1.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.1.1.tm index c64720d2..750e6518 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.1.1.tm +++ b/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 diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/du-0.1.0.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/du-0.1.0.tm index ad27135d..1ebad3f0 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/du-0.1.0.tm +++ b/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] + if {$opt_patterndebug} { + 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 { - if {$opt_patterndebug} { - puts stderr ">>>du_dirlisting_twapi winglob: $win_glob" - puts stderr ">>>du_dirlisting_twapi tclre : $tcl_re" - } #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" + #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 + } + } set do_sizes $do_sizes_l set do_times $do_times_l - - 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} { - #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 {$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 {!$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 } diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/lib-0.1.6.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/lib-0.1.6.tm index fe8cfc7e..08e870eb 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/lib-0.1.6.tm +++ b/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. } + #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. diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm index 6d877c5f..729d0ffb 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm +++ b/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,36 +1908,52 @@ tcl::namespace::eval punk::nav::fs { set ts "$key vs [dict keys [dict get $contents times]]" } set note "" + 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"} { + 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 $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]" - } - 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"]"] - } + + #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] @@ -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) diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl-0.1.2.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl-0.1.2.tm index 486720e8..73e5c925 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl-0.1.2.tm +++ b/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 diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/winlnk-0.1.1.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/winlnk-0.1.1.tm index 6c31f56a..ee70e368 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/winlnk-0.1.1.tm +++ b/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] } } diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.2.1.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.2.1.tm index cb6f796b..d2ed8045 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.2.1.tm +++ b/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. diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.1.1.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.1.1.tm index c64720d2..750e6518 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.1.1.tm +++ b/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 diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/du-0.1.0.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/du-0.1.0.tm index ad27135d..1ebad3f0 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/du-0.1.0.tm +++ b/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] + if {$opt_patterndebug} { + 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 { - if {$opt_patterndebug} { - puts stderr ">>>du_dirlisting_twapi winglob: $win_glob" - puts stderr ">>>du_dirlisting_twapi tclre : $tcl_re" - } #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" + #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 + } + } set do_sizes $do_sizes_l set do_times $do_times_l - - 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} { - #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 {$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 {!$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 } diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/lib-0.1.6.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/lib-0.1.6.tm index fe8cfc7e..08e870eb 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/lib-0.1.6.tm +++ b/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. } + #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. diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm index 6d877c5f..729d0ffb 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm +++ b/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,36 +1908,52 @@ tcl::namespace::eval punk::nav::fs { set ts "$key vs [dict keys [dict get $contents times]]" } set note "" + 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"} { + 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 $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]" - } - 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"]"] - } + + #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] @@ -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) diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl-0.1.2.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl-0.1.2.tm index 486720e8..73e5c925 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl-0.1.2.tm +++ b/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 diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/winlnk-0.1.1.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/winlnk-0.1.1.tm index 6c31f56a..ee70e368 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/winlnk-0.1.1.tm +++ b/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] } } diff --git a/src/vfs/_vfscommon.vfs/modules/punk/args-0.2.1.tm b/src/vfs/_vfscommon.vfs/modules/punk/args-0.2.1.tm index cb6f796b..d2ed8045 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/args-0.2.1.tm +++ b/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. diff --git a/src/vfs/_vfscommon.vfs/modules/punk/console-0.1.1.tm b/src/vfs/_vfscommon.vfs/modules/punk/console-0.1.1.tm index c64720d2..750e6518 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/console-0.1.1.tm +++ b/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 diff --git a/src/vfs/_vfscommon.vfs/modules/punk/du-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/du-0.1.0.tm index ad27135d..1ebad3f0 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/du-0.1.0.tm +++ b/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] + if {$opt_patterndebug} { + 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 { - if {$opt_patterndebug} { - puts stderr ">>>du_dirlisting_twapi winglob: $win_glob" - puts stderr ">>>du_dirlisting_twapi tclre : $tcl_re" - } #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" + #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 + } + } set do_sizes $do_sizes_l set do_times $do_times_l - - 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} { - #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 {$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 {!$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 } diff --git a/src/vfs/_vfscommon.vfs/modules/punk/lib-0.1.6.tm b/src/vfs/_vfscommon.vfs/modules/punk/lib-0.1.6.tm index fe8cfc7e..08e870eb 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/lib-0.1.6.tm +++ b/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. } + #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. diff --git a/src/vfs/_vfscommon.vfs/modules/punk/nav/fs-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/nav/fs-0.1.0.tm index 6d877c5f..729d0ffb 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/nav/fs-0.1.0.tm +++ b/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,36 +1908,52 @@ tcl::namespace::eval punk::nav::fs { set ts "$key vs [dict keys [dict get $contents times]]" } set note "" + 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"} { + 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 $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]" - } - 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"]"] - } + + #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] @@ -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) diff --git a/src/vfs/_vfscommon.vfs/modules/punk/repl-0.1.2.tm b/src/vfs/_vfscommon.vfs/modules/punk/repl-0.1.2.tm index 486720e8..73e5c925 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/repl-0.1.2.tm +++ b/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 diff --git a/src/vfs/_vfscommon.vfs/modules/punk/winlnk-0.1.1.tm b/src/vfs/_vfscommon.vfs/modules/punk/winlnk-0.1.1.tm index 6c31f56a..ee70e368 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/winlnk-0.1.1.tm +++ b/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] } }