#
# <20240308.1300.20>
#
# This was shamelessly lifted (-and greatly modified) from the
# init.tcl source in tcl.

# But why??
#
# First:   That version returns and saves files with paths of "./"
#          This, of course, fails if the working directory changes.
# Second:  That version returns files that are not executable, if
#          such files exist in a given path dir. Or in PATHEXT
#          I.e. if looking for xyz we expect xyz.exe not xyz even
#          though it may exist.
# Third:   I would contend that files found in "." should not be
#          cached if "." is not in PATH. In fact anything not in Path
#          should not be cached.
# Fourth:  I would also contend that "." should be searched before
#          [info nameofexecutable].
# Fifth:   Failure to find an executable should not be cached. After
#          all the world is still spinning, so it may appear next time
#          if only we look.
# Sixth:   I would contend that system paths not in PATH should be
#          searched only after those in PATH.
# Seventh  Extensions in PATHEXT but not in {.cmd .exe .com .bat} are
#          returned as executable, but are not. These types require
#          an interpretor. We provide an option to supply this.
# Eighth   The usefull shell builtins: assoc, ftype, mkdir, mklink,
#          and move are missing.
#          

# Note that info executable doesn't work under Windows, so we have to
# look for files with .exe, .com, or .bat extensions.  Also, the path
# components are separated with semicolons, not colons as under Unix.

# None of this is usable unless we are in MS windows...

# We need this outside of the MSW only so that build index will find it.
# We will call this only on windows platforms. It forces replacement
# of the standard auto_execok code...

proc load_now_auto_execok {} {}

if {$tcl_platform(platform) != "windows"} {
  # if not on windows, terminate the loading
  return
}

# This routine replaces any %xyz% strings with env(xyz) if possible.
proc expandEnvRefs {string} {
  frputs string
  regsub -all {\\} [subst [regsub -all {%([^ %]+)%} [regsub -all {\\} $string {/}] \
			       {[expandEnvHelp "\1"]}]] {/}}

proc expandEnvHelp {who} {
  frputs who
  expr {[info exist ::env($who)] ? $::env($who) : "%$who%"}}
# From time to time we may want to rebuild the path
# we put this here to share it...

namespace eval auto_execNS {
  if {![info exists ::auto_execNS::path]} {
    variable path {}
    variable shellBuiltins
    variable execExtensions
    variable unixExtensions {.tcl .sh .pl}
    # build the static path...  
  }
  # The exec man page says the search order is:
  # our tcl load dir
  # the current dir
  # windows NT dirs
  # then the path
  #
  # I don't think that the system dirs should come before
  # the user path dirs, also if s/he wants '.' it is easy
  # to prefix with "./". Still I suppose There should be
  # the option (at least) to include "." (but unix does not).
  # As for the tcl load dir, let them put it in the path.
  # Also, the windows NT dirs should be in the system part
  # of the path.
  
  # The order we use here is:
  #
  # User part of the path followed by the
  # system part. Since these are folded into
  # one by the system, we don't use env(path),
  # but rather the registry.
  #
  # args is here to allow us to be called by the trace command

  # proc fNorm {file} {regsub {\\} [file norm $file] {/}}
    
  
  proc buildPath {args} {
    variable path {}
    variable shellBuiltins
    variable execExtensions
    # Registery addresses are:
    set userRegPath HKEY_CURRENT_USER\\Environment
    set sysRegPath\
	HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Control\\Session\ Manager\\Environment
  
    # Registry or twapi, that is the question...
    lassign {} sysPath userPath
    package require registry
    set r [catch [list registry get $sysRegPath Path] sysPath]
    set sysPath [split [expandEnvRefs $sysPath] ";"]
    
    set r2 [catch [list registry get $userRegPath Path] userPath]
    set userPath [split [expandEnvRefs $userPath] ";"]
    # frputs #2 #3 #4 args r sysPath r2 userPath
    foreach us {userPath sysPath} {
      foreach pa [set $us] {
	lappend $us [expr {$pa == "." ? "." : [file norm $pa]}]
      }
    }
    # We join the two versions (registery and current process) to
    # make sure we have any changes.
    foreach pa [concat [split $::env(path) ";"] $userPath] {
      set nf [expr {$pa == "." ? "." : [file norm $pa]}]
      if {[lsearch -exact -nocase $sysPath $nf] == -1 &&\
	      [lsearch -exact -nocase $path $nf] == -1} {
	lappend path $nf
      }
    }
    # Now add the system paths
   
    foreach pa $sysPath {
      set pa [expr {$pa == "." ? "." : [file norm $pa]}]
      if {[lsearch -exact -nocase $path $pa] == -1} {
	lappend path $pa
      }
    }
    set shellBuiltins [list assoc cls copy date del erase dir echo\
			   ftype mkdir md mklink move rename ren rmdir \
			   rd time type ver vol]
    if {$::tcl_platform(os) eq "Windows NT"} {
      # NT includes the 'start' built-in
      lappend shellBuiltins "start"
    }
    if {[info exists env(PATHEXT)]} {
      # Add an initial ; to have the {} extension check first.
      set execExtensions [split [string tolower ";$env(PATHEXT)"] ";"]
    } else {
      set execExtensions [list {} .com .exe .bat .cmd]
    }
    # Set up the path we want to export
    if {1} {
      foreach pa $path {
	lappend tmpPath [file native $pa]
      }
      set ::env(path) [join $tmpPath ";"]
    }
    unset -nocomplain ::auto_execs
  }
}
trace add variable env(path) write ::auto_execNS::buildPath
trace add variable env(PATH) write ::auto_execNS::buildPath

::auto_execNS::buildPath [incr ld]
#
# Here are a couple of helper functions:
# 
# This function uses the file ext to look in the MS windows registry and
# find the command to open the file.  It then builds that command and
# returns a result compatable with the windowsAutoExecOk code i.e.
# a command for frFEC. Usually this will consist of the command and a
# list to pass in the 'params' part of the frFEC call. Note that this
# should only be called with a normalized and existant file.
#  Null return indicates that there is no such entry in the registry.
#
# This code has the possible need for advanced work by the caller as the
# parameters may be specified in such a way that they must be sorted into a
# different order. The will be a bigger chore if it is used in a pipe line.
# Mostly this is fixed by not sending a trailing "%b" but patterns that sort
# the parameters before the target file are likely going to fail.

proc getMSWopenCommand {file} {
  global env
  upvar auto_execNS::auto_exts auto_exts
  ## frputs file
  set ext [string tolower [file extension $file]]
  
  # This is dodge to avoid .cmd bug "4ab2ccc4a26e39e630ab96f7e9281b60181ea5e9"
  # if {[regsub -all {\.} [info patchlevel] {0}] < 80606} {
  #   if {[string match -nocase $ext .cmd]} {
  #     return "[auto_execok $env(COMSPEC)] /c [list $file]"
  #   }
  # }
  if {![info exists auto_exts($ext)]} {
    # look in registry for the answer..
    set root HKEY_CLASSES_root
    set r [catch [list registry get HKEY_CLASSES_ROOT\\$ext {}] type]
    if {$r != 0} {return {}}
    set r [catch [list registry get \
		      HKEY_CLASSES_ROOT\\$type\\Shell\\open\\command {}] f]
    if {$r != 0} {return {}}
    # To avoid backslash hell, we use forward here...
    set f [regsub -all "\\\\" $f {/}]
    frputs STR ext f
    set auto_exts($ext) $f
    # frputs "from reg after bs  " f type
  } else {
    set f $auto_exts($ext)
    # frputs "cache!!  " f
  }
  # now we need to remove any env vars.  They look like %stuff%.
  # We use expandEnvRefs for this.
  # There are also parm substitution that look like:
  # since we are doing this for "frECF" we will do that convention
  # %0 or %1   takes the target file --> fixed here
  # %2 - %9    gets parms 1 through 8--> %n@q where 2->1, 3->2 etc.
  # %*         gets all parms        --> %b
  # %~n        (n is 2-9) gets all parms starting with n -->%b
  # BUT, in general we have two files, the target and the parm
  # so we should be safe returning 'target %b' parm
  #
  
  set pers [patternStringSearch "%" [set f [expandEnvRefs $f]]]
  frputs ext f pers
  set start 0
  set newf {}
  while {$pers != {}} {
    set pers [lassign $pers idx]
    set idx [lindex $idx 0]
    append  newf [string range $f $start $idx-1]
    set ch [string index $f $idx+1]
    frputs pers idx ch f start newf file
    switch -exact $ch {
      l -
      L -
      0 -
      1 {
	append newf  $file ; # [file native $file]
	incr insert
      }
      2  -
      3  -
      4  -
      5  -
      6  -
      7  -
      8  -
      9   {return {}}
      "*"   {
	append newf "%b"
	 frputs newf
      }
      "~"   {append newf "%b"; [incr idx]}
      default {
	set pers [lassign $pers idx2]
	set idx2 [lindex $idx2 0]
	if {$idx2 == {} ||\
		![info exists \
		      env([set ita [string toupper \
					[string range $f $idx+1 $idx2-1]]])]} {
	  # A mal-formed env reference or something...
	  puts "Malformed string=> \"$ch\" in \"$f\". Giving up"
	  return {}
	}
	append newf [regsub "\\\\" $env($ita) {/}]
	set idx [incr idx2 -1]
      }
    }
    set start [incr idx 2]
  }
  append newf [string range $f $start end]
  if {[string range $newf end-1 end] == "%b"} {
     frputs newf 
    set newf [string range $newf 0 end-2]
  }
  if {![info exists insert]} {
    append newf " " $file
  }
  frputs f newf
  return $newf
}

# This function tries to pull a script apart to get the program that runs it.
# The other option is that the file turns into a program via an 'exec' call
# In the first case we want to have 'file' -> something.exe 'file'
# In the second case we want to have 'file' -> something.exe
# The exec call goes the first way if the first parm is $0
# In any case we need to build this here where we know what the exec call looks
# like

proc getScriptsEx {file} {
  set str [read [set fid [open $file r]] 2000]
  close $fid
  set dat [split $str \n]
  set str [lindex $dat 0]
  ## frputs str
  set out {}
  if {[string range $str 0 1] == "#!"} {
    # so far so good, see what the file name looks like
    # We get radical here and look at the tail of the line first
    # The notion is that we may have something like:
    #!/bin/sh -c foo -op
    # where what we want is 'foo -op' as long as 'foo' is an exectuable
    # The prime motivation here is to prevent multiple interpitations
    # of a possibly quoted file name
    
    set str " [string trim [string range $str 2 end]]"
    set es [string length $str]
    set tail {}
    set out {}
    while {[set star [string last " " $str $es-1]] != -1} {
      set fname [string trim [string range $str $star+1 $es]]
      set fname [file tail [file root $fname]]
      # Is this a recognizable executable?
      # Ah recursion is nice
      ## frputs fname
      if {$fname != {} && \
	      [set out [auto_execok $fname]] != {} || \
	      ([set tfname [file tail $fname]] != $fname && \
		   [set out [auto_execok $tfname]] != {}) } {
	append out " " $file
	break
      }
		 # not this, try backing up
      set tail "$fname $tail"
      set es $star
    }
  }
  # return $out
  if {$out == {}} {return {}}
  set prog [file tail [file rootname [lindex $out 0]]]
  set out2 $out
  if {$prog in {sh bash}} {
    # This could be a dodge to 'exec' another script handler
    set out2 {}
    foreach line $dat {
      set line [string trim $line]
      if {[string length $line] == 0 ||\
  	      [string index $line 0] == "#"} {continue}
      # allow a PATH=
      if {[string match "PATH=*" $line]} {continue}
      if {![string match "exec *" $line]} {break}
      # We found an exec, pull out the target...
      set trimln [string trim [string range $line [string first " " $line] end]]
      set progx [string range $trimln 0 [set es [string first " " $trimln]]-1]
      set out2 [auto_execok $progx]
      break
    }
    # frputs "We have something  " out
    # Still here.. "out" is the result, need to include the rest of the line
    # Not file, just parms
    # set file [file native $file]
    ## frputs out out2 prog progx
    # set out "[lindex $out 0] %s"
    if {$out2 != {}} {
      if {[set rm [string range $trimln $es+1 end]] != {}} {
  	# Lets toss the parms and keep the options....
  	set kp [string range $rm 0 [string first {$} $rm]-1]
  	#set rm [string trim [regsub {"\$@"} $rm {}]]
  	append out2 " " [string trim [regsub {"\$@"} $rm {}]]
      }
      # We have a $0. if not the first $, pass back the pre exec result
      ## frputs out2 rm
      if {[string match {*\$0*} $rm]} {
  	if {[string index $rm [string first {\$} $rm]+2] == "0"} {
  	  append out2 " " $file
  	} else {
  	  # We don't know how to handle this. Lets force it back to
  	  # the #! file
  	  set out2 $out
  	}
      }
    } else {
      set out2 $out
    }
  }  
  ## frputs out2 out
  return $out2
}

# This is a local function to consolidate common code.
# Do not attmept to call this else where..

proc auto_checkIfEx {fileNorm} {
  global env auto_execs
  upvar ::auto_execNS::path path
  upvar ::auto_execNS::execExtensions execExtensions
  upvar ::auto_execNS::unixExtensions unixExtensions

  # DO NOT PUT THIS IN GLOBAL SPACE it may cause freewrap version to not come up
  # frWinBits moves the package...
  
  package require twapi ;# To track down shortcuts..
  
  upvar name name
  ## frputs fileNorm
  foreach ext [concat $execExtensions $unixExtensions] {
    set file ${fileNorm}${ext}
    set exists [file exists $file]
    if {!$exists && [file exists $file.lnk]} {
      array set tmp [twapi::read_shortcut $file.lnk -noui -nosearch -timeout 0]
      if {![file exists [set file [file join $tmp(-path)]]]} {continue}
    } elseif {!$exists || [file isdirectory $file]} {continue}
    # make sure this is executable
    ## frputs file
    # Note: a side effect of the 'file normalize' is that it fixes the
    # case to be the actual case. This may be important in some cases.
    frputs file
    set file [file norm $file] 
    if {[set thisext [string tolower [file extension $file]]] != {} &&\
	    $thisext in $execExtensions} {
      frputs STR name "[list $file] " file
      return [set auto_execs($name) [list $file]]
	
	
      # We know the file exists AND does not have an executable ext.
      # So try for a *nix type file...
      
      # There are two possibilities left.
      # 1.) It is a unix type script which starts with the thing to execute
      # 2.) It has an entry in the windows registry.
      
      # While it is faster to check 2 we do it last as we want to
      # give precedence to the actual file.
      
      # We assume that the path name in such a line was set for *nix and
      # may not be valid here.	
      
    } elseif {[set out [getScriptsEx $file]] == {}} { 
      # last chance, see if the system knows...
      # Do we always want to do this??? or just on
      set out [getMSWopenCommand $file]
    }
    if {$out == {}} {continue}
    # Can not trust 'format' here as it miss handles the backslashes

    # Get the true long name
    # foreach rm [list {*}$out] {
    #   if {$rm == "%s"} {
    # 	lappend ans [file native $file]
    # 	incr finc
    #   } else {
    # 	lappend ans $rm
    #   }
    # }
    # if {![info exists finc]} {
    #   lappend ans [file native $file]
    # }
    # # set ans [list {*}[format $out [list [list [file native $file]]]]]
    ## frputs out file 
    # save this only if we got here on the path
    # if {[lsearch -nocase -exact $path [file dirname $file]] != -1} {
    # }
    frputs STR name "[list $out] " out
    return [set auto_execs($name)  $out]
   }
  return {}
}
#
# Track down shortcuts.
# If it is a shortcut, returns the target file name
# If it is not         returns the name passed in
# If it is a shortcut but not to a file, throw error
#
proc LnkFile {filename} {
  if {[catch {twapi::read_shortcut $filename -noui -nosearch} ans] != 0} {
    return $filename
  }
  array set info $ans
  # frputs "[array get info] "
  set ans [file join $info(-path)]
  if {[file exists $ans]} {return $ans}

  error "Does not exist as a file: \"$ans\""
}

# By convention we always export/return file names normalized and
# NOT native.

proc auto_execok {name} {
  global auto_execs env tcl_platform
  upvar ::auto_execNS::path path
  upvar ::auto_execNS::shellBuiltins  shellBuiltins
  upvar ::auto_execNS::execExtensions execExtensions 
  
  # Just in case we have a quote protected name...
  frputs #3 #2 IN name
  set name [regsub {\"([^\"]*)\"} [regsub -all {\\} $name {/}] {\1}]
  if {[info exists auto_execs($name)]} {
    foreach ent $auto_execs($name) {
      if {![file exist $ent]} {
	unset auto_execs($name)
	return [auto_execok $name]
      }
    }
    return $auto_execs($name)
  }
  frputs execExtensions
  if {[lsearch -exact -nocase $shellBuiltins $name] != -1} {
    # When this is command.com for some reason on Win2K, Tcl won't
    # exec it unless the case is right, which this corrects.  COMSPEC
    # may not point to a real file, so do the check.

    # We do recursion for this...
    
    if {[set cmd [auto_execok $env(COMSPEC)]] != {}} {
      return [set auto_execs($name) [list $cmd /c $name]]
    }
  }
  # build the full path early so we can easily check if the
  # answer is from a dir on the path
  # Now if a path was provided...
  set name [regsub {\{(.*)\}$} $name {\1}]
  ## frputs name
  # First lets resolve any links...
  if {[catch {LnkFile $name} name] != 0} {return {}}
  set fileNorm [file normalize $name]
  if {[llength [file split $name]] > 1} {
    # if the user supplied a name with part of a path, (e.g. ./file or file/foo)
    # then it is really only refering to the normalized name
    # so we should not search.
    set tmp [auto_checkIfEx $fileNorm]
    # if {$tmp == {} && [] !={}} {
    #   set auto_execs($fileNorm) $tmp
    # }
    if {$tmp != {}} {
      return $tmp
    }
    # all that is left is the 'ext' test
  } else {

    # # A simple name with no path...
    # if {[string match -nocase {[a-z]:*} $name]} {
    #   # a volumn relative name, just return nil
    #   return {}#
    # }

    # Here we take a generic name and try all the possible ext's and
    # paths
    ## frputs name
    # The checking of '.' is a windows thing? Should this be optional?
    # Only do . if {} is in the path
    foreach dir  $path {
      if {$dir == {}} {
	set dir "."
      }
      if {$dir == "."} {
	set dir [file norm $dir]
      }
      # frputs dir
      if {[string match {//wsl$/*} $dir]} {
	# If this is a wsl path we do things a bit differently.
	#
	## frputs dir
	if {![file exist $dir/$name]} {continue}

	# Well the name matches...
	lassign {} exp
	set ans [::fileutil::fileType $dir/$name]
	if {![set ex [string match "* executable *" $ans]]} {
	  if {![string match "* script *" $ans]} {continue}
	  # This is a bit more complicated...
	  #
	  if {[set out [getScriptsEx $dir/$name]] == {}} {continue}
	  set rtn [list {*}$out]
	} else {
	  # Its executable
	  set rtn [list $dir/$name]
	}
      } else {
	# not a WSL path
      
	 frputs dir name

	if {[set rtn [auto_checkIfEx $dir/$name]] != {}} {break}
      }
    }
    if {$rtn != {}} {
      frputs STR name rtn
      set auto_execs($name) $rtn
    }
    ## frputs auto_execs($name)
    if {$dir ni $path} {
      ## frputs
      unset -nocomplain auto_execs($name)
    }
    frputs rtn
    return $rtn
  }
  return {}
}

# For what its worth, I am not too keen on the *nix version of auto_execok
# but that is in the other lib.
