# -*- tcl -*- # Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from -buildversion.txt # # Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. # Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # (C) 2023 # # @@ Meta Begin # Application punk::unixywindows 0.1.0 # Meta platform tcl # Meta license # @@ Meta End # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Requirements ##e.g package require frobz #for illegalname_test package require punk::winpath # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ namespace eval punk::unixywindows { #'cached' name to make obvious it could be out of date - and to distinguish from unixyroot arg variable cachedunixyroot "" #----------------- #e.g something like c:/Users/geek/scoop/apps/msys2/current c:/msys2 proc get_unixyroot {} { variable cachedunixyroot if {![string length $cachedunixyroot]} { if {![catch { set result [exec cygpath -m /] ;# -m gives result with forward-slashes - which is ok for windows paths in a Tcl context. set cachedunixyroot [punk::valcopy $result] file pathtype $cachedunixyroot; #this call causes the int-rep to be path #set ::punk::last_run_display [list] ;#hack - review shouldn't really be necessary.. but because we call winpath from ./ - the repl looks for last_run_display } errM]} { } else { puts stderr "Warning: Failed to determine base for unix-like paths - using default of c:/msys2" file pathtype [set cachedunixyroot [punk::valcopy "c:/msys2"]] } } #will have been shimmered from string to 'path' internal rep by 'file pathtype' call #let's return a different copy as it's so easy to lose path-rep set copy [punk::valcopy $cachedunixyroot] return $copy } proc refresh_unixyroot {} { variable cachedunixyroot set result [exec cygpath -m /] ;# -m gives result with forward-slashes - which is ok for windows paths in a Tcl context. set cachedunixyroot [punk::valcopy $result] file pathtype $cachedunixyroot; #this call causes the int-rep to be path set copy [punk::valcopy $cachedunixyroot] return $copy } proc set_unixyroot {windows_path} { variable cachedunixyroot file pathtype $windows_path set cachedunixyroot [punk::valcopy $windows_path] #return the original - but probably int-rep will have shimmered to path even if started out as string #- that's probably what we want. Caller can use as string or path without affecting cachedunixyroot return $windows_path } proc windir {path} { if {$path eq "~"} { #as the tilde hasn't been normalized.. we can't assume we're running on the actual platform return ~/.. } return [file dirname [towinpath $path]] } #REVIEW high-coupling proc cdwin {path} { set path [towinpath $path] if {[package provide punk::repl::codethread] ne "" && [punk::repl::codethread::is_running]} { if {[llength [info commands ::punk::console::titleset]]} { ::punk::console::titleset $path } } cd $path } proc cdwindir {path} { set path [towinpath $path] if {[package provide punk::repl::codethread] ne "" && [punk::repl::codethread::is_running]} { if {[llength [info commands ::punk::console::titleset]]} { ::punk::console::titleset $path } } cd [file dirname $path] } #NOTE - this is an expensive operation - avoid where possible. #review - is this intended to be useful/callable on non-windows platforms? #it should in theory be useable from another platform that wants to create a path for use on windows. #In this case - we shouldn't examine what volumes exist (assume A: .. Z: are valid) #review zipfs:// other uri schemes? proc towinpath {unixypath {unixyroot ""}} { #NOTE: tcl file exists gives different answers on windows for paths like /c depending on cwd (presumably based on file pathtype of volumerelative) #(Tcl is also somewhat broken as at 2023 as far as volume relative paths - process can get out of sync with tcl if cd to a vol relative path is used) #This is add odds with attempting to navigate on a windows system which has cygwin, wsl etc... It also makes it difficult for functions intended to operate independent of CWD. #e.g there is potential confusion when there is a c folder on c: drive (c:/c) #I will attempt to provide a coherent operation for winpath ./ ../ etc , but it may disallow for example; change to /something or /x where these don't match a driveletter or /mnt #whereas tcl may allow cd to /something if a something folder happens to exist on the current volume based on cwd. #I think it's preferable to require an explicit driveletter /x or /mnt when using unix-like paths on windows - but practical considerations may prove me wrong.. #It's possible that this function should also ignore the current set of driveletters - and operate completely independent of whether a path actually exists #This makes it hard to use things like 'file normalize' - which also looks at things like current volume. # #Note for example the results of 'which' grep on windows can produce a path like /c/Users/somewhere/bin/grep #which tcl's file normalize may change to C:/c/Users or X:/c/Users - based on current volumen. Given that C:/c might exist - this can be problematic in a couple of ways. #The mixing of unix-like and windows commands on the same machine is a large part of the problem.. but this mix is now common # #convert /c/etc to C:/etc set re_slash_x_slash {^/([[:alpha:]]){1}/.*} set re_slash_else {^/([[:alpha:]]*)(.*)} set volumes [file volumes] #exclude things like //zipfs:/ ?? set driveletters [list] foreach v $volumes { if {[regexp {^([[:alpha:]]){1}:/$} $v _ letter]} { lappend driveletters $letter } } #puts stderr "->$driveletters" set path [punk::valcopy $unixypath] ;#take another copy that we can deliberatley shimmer to path and know is separate to the supplied argument set supplied_pathtype [file pathtype $path] ;#we don't care about the pathtype so much as the act of making this call shimmers to a path internal-rep #copy of var that we can treat as a string without affecting path rep #Note that some but not all read operations will lose path rep e.g 'string length $x' will lose any path-rep $x had, (but 'string equal $x something' won't) #Todo - make int-rep tests to check stability of these behaviours across Tcl versions! set strcopy_path [punk::valcopy $path] set str_newpath "" set have_pathobj 0 if {[regexp $re_slash_x_slash $strcopy_path _ letter]} { #upper case appears to be windows canonical form set str_newpath [string toupper $letter]:/[string range $strcopy_path 3 end] } elseif {[regexp {^/mnt/([[:alpha:]]){1}/.*} [string tolower $strcopy_path] _ letter]} { set str_newpath [string toupper $letter]:/[string range $strcopy_path 7 end] } elseif {[regexp {^/mnt/([[:alpha:]]){1}$} [string tolower $strcopy_path] _ letter]} { set str_newpath [string toupper $letter]:/ } elseif {[regexp $re_slash_else $strcopy_path _ firstpart remainder]} { #could be for example /c or /something/users if {[string length $firstpart] == 1} { set letter $firstpart set str_newpath [string toupper $letter]:/ } else { #according to regex we have a single leading slash set str_tail [string range $strcopy_path 1 end] if {$unixyroot eq ""} { set unixyroot [get_unixyroot] } else { file pathtype $unixyroot; #side-effect generates int-rep of type path ) } set pathobj [file join $unixyroot $str_tail] file pathtype $pathobj set have_pathobj 1 } } if {!$have_pathobj} { if {$str_newpath eq ""} { #dunno - pass through set pathobj $path } else { set pathobj [punk::valcopy $str_newpath] file pathtype $pathobj } } #puts stderr "=> $path" #things like 'which' seem to return a path minus the .exe - so we'll just test the containing folder # #By now file normalize shouldn't do too many shannanigans related to cwd.. #We want it to look at cwd for relative paths.. #but we don't consider things like /c/Users to be relative even on windows where it would normally mean a volume-relative path e.g c:/c/Users if cwd happens to be somewhere on C: at the time. #if {![file exists [file dirname $path]]} { # set path [file normalize $path] # #may still not exist.. that's ok. #} #file normalize may change backslashes to forward slashes.. including things like the special \\?\ prefix which is intended to stop windows api from parsing a name #2023 - this is ok as //?/ also seems to work.. but it is unclear if that is because Tcl is re-converting to backslashes if {[punk::winpath::illegalname_test $pathobj]} { set pathobj [punk::winpath::illegalname_fix $pathobj] } return $pathobj } #---------------------------------------------- #leave the unixywindows related aliases available on all platforms #interp alias {} cdwin {} punk::unixywindows::cdwin #interp alias {} cdwindir {} punk::unixywindoes::cdwindir #interp alias {} towinpath {} punk::unixywindows::towinpath #interp alias {} windir {} punk::unixywindows::windir #---------------------------------------------- } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::unixywindows [namespace eval punk::unixywindows { variable version set version 0.1.0 }] return