#
#<20240217.1842.08>
#
# This module contains bits of filerunner that are pure windows
# Putting this stuff here lightens the load on other platforms
#
# This bit will be sourced in global space

# This function (by name) triggers sourceing by the pkgIndex for
# the platform
startProc "First light in Win Platform"

if {[set it [info script]] ni $::auto_path} {
  lappend ::auto_path $it
}
unset -nocomplain it

proc load_now_fr_bits {} {}

# This is the turn on setup unique to this platform

set glob(os) WIN32
set ::MSW 1
set ::CASEops "-nocase"
# set ::TMP $::env(TMP)
# We want a unique name for the title, for speed and efficiency we will
# just encode the pid.
#
proc pidBase62 {} {
  set d ""
  set wpid [pid]
  while {$wpid > 0} {
    set rm [expr {$wpid % 62}]
    set wpid [expr {$wpid / 62}]
    append d [format %c [expr {$rm < 10 ? ($rm + 48) : $rm < 36 ? ($rm + 55) : ($rm + 61)}]]
  }
  return [string reverse $d]
}
set glob(orgTitle) "(fr #[pidBase62])"

proc buildTbarIcon {} {
  global glob
  wm iconbitmap . -default $glob(lib_fr)/icons/filerunner-icons.ico
  # This is called after init config so we have an opportunity do
  # platform specific config initialization.
  # We may want to rethink this later....
  # For now we will put these at the head of the button list
  
  # Here we add platform dependent buttons for the middle list.
  # format is the same as in fr.
  set properties {
    {{Properties} CmdProperties "" 0 \
	 {[_b "Brings up the MSW file properties window for selected file(s)." ]}}
    {{Short Cut} CmdCreateShortCut "" 0\
	 {[_b "Create a short cut for selected file(s)."]}}
    {{Short CutAS} CmdCreateShortCutAs "" 0\
	 {[_b "Create a short cut for selected file(s) with a new name."]}}
  }
  foreach platformButton $properties {
    lappend add [list [lindex $platformButton 0]]
    if {[lsearch -exact -index 0 $glob(cmds,list) [lindex $platformButton 0]] == -1} {
      lappend glob(cmds,list) $platformButton
    }
  }
  set ::config(middle_button_list) [linsert $::config(middle_button_list) 0 {*}$add]
}


startProc "After icon set up"

# if this is a wrapped process we move the twapi package to our
# private location to, well basically uncompress it.
if {[namespace exists freewrap]} {
  # If it exists and is the right version, leave well enough alone
  # Note that version is in the pkgIndex so we just compare the whole thing
  # We also skip this if twapi is built into the wrapper
  if {![file exists /zvfs/twapi]} {
    # not in the wrapper
    set twapiAdd [lindex [zvfs::list */twapi] 0]
    set r [catch {read [set fid [open $twapiAdd r]]} dat]
    set r2 [catch {read [set fid2 [open $glob(conf_dir)/twapi/pkgIndex.tcl r]]} dat2]
    catch {close $fid}
    catch {close $fid2}
    if {$r + $r2 != 0 || $dat != $dat2} {
      file copy -force [zvfs::list */twapi] $glob(conf_dir)/twapi
    } else {
      # puts "twapi ok"
    }
    lappend ::auto_path $glob(conf_dir)/twapi
  }
}

# puts "$::auto_path"
package require twapi
set ::Elevated [expr {[twapi::get_process_elevation] == "full"}]

startProc "After Twapi set up"

# We are agressive about cleaning up our tmp dir
proc cleanTmpFiles {} {
  global glob
  package require dde
  dde servername [pid]
  set servers [dde services TCLEval {}]
  foreach pid $servers {
    lappend pids [lindex $pid 1]
  }
  set dmess {}
  set glob(tmpdir) $glob(conf_dir)/tmp[pid]
  if {![file isdirectory $glob(tmpdir)]} {
    if {![file exists $glob(tmpdir)]} {
      set r [Try { file mkdir $glob(tmpdir) } "" 1]
      if {$r != 0} {
	lappend dmess [_ "Can't create %s. May be problems later" $glob(tmpdir)]
      }
    }
  }
  foreach dir [glob -tails -directory $glob(conf_dir) tmp*] {
    set who [regsub {tmp} $dir {}]
    if {$who == {} && [glob -nocomplain $glob(conf_dir)/tmp/*] != {}} {continue}
    if {$who ni $pids} {
      if {[catch {file delete -force $glob(conf_dir)/tmp$who} ms]} {
	lappend dmess $ms
      }
    }
  }
  if {$dmess != ""} {
    lappend ::mess "Error managing tmp files:"
    lappend ::mess {*}$dmess
  }
}
########################## end of general platform set up ##################
proc inotifySetUp {} {

}
# stubs for windows, used only in unix

proc GetUidGidString { file uid gid } {
    return ""
}

proc GetStringFromMode { mode } {
  global glob
  if { $::tcl_platform(platform) == "windows"} {
    return [format "0x%x" $mode]
  }
}

# The window kill function...
proc killInit {} {
  if {[catch {package require Tclx}] != 0} {
    proc kill {pids} {
      foreach pid $pids {
	twapi::end_process $pid -force
      }
      return {}
    }
  }
  return {}
}


# This routine is to get the full disc size. On
# *nix system it also returns the mount point of the
# containing file system


# Ok, take 2. Lets use the twapi com code to do this.
# our private global

# take 3.

# namespace eval ::oo {
#   variable fso  {}
#   variable drives {}
# }

proc GetDF { dir } {
  # frputs dir
  set ans [lindex [::twapi::get_volume_info [lindex [file split $dir] 0] -freespace]]
  #frputs ans
  if {[string index $ans end-1] == "."} {
    set ans [string range $ans 0 end-2]
  }
  #frputs ans
  return [list [formatDF $ans] {}]  
}


# This code in some senses emulates the linux version of inotify to
# handle the same functionallity on MSW.

# The watch takes:
# what   add or remove to set up or remove a watch
# which  the directory to monitor
# how    the watch flags

proc notifywatch {what which {how {}}} {
  global ::inotify::dirs
  # We only allow two monitors at a time, attempting more is
  # An error..
  if {$what == "add"} {
    if {[llength $dirs] >=2} {
      # frputs dirs which how
      return -code error "Attempting to monitor more than 2 dirs"
    }
    # frputs which how
    if {[catch {::twapi::begin_filesystem_monitor \
		    $which [list notecallback $which] {*}$how} out] != 0} {
      # frputs out which how
      return -code error $out
    }
    # sweet success...
    lappend dirs [list $which $out]
    return $which
  }
  # must be a remove
  set ndirs {}
  foreach dir $dirs {
    lassign $dir di han
    # frputs dir di han
    if {$di == $which} {
      ::twapi::cancel_filesystem_monitor $han
      incr found
      continue
    }
    lappend ndirs $dir
  }
  if {![info exists found]} {
    frputs  which dirs ndirs
    return -code error "$which not found in monitored directories"
  }
  set dirs $ndirs
}

proc notecallback {args} {
  global glob config
  set did 0
  set found {}
  # frputs args
  
  # For windows notecallback gets:
  # arg0   the directory we are monitoring
  # arg1   the monitor handle (not of any use here)
  # arg3   a list of dublets (where fd is the file name):
  # 'added' fd, 'removed' fd, 'modified' fd, 'renameold' fd, 'renamenew' fd
  # or 'error' error-code.
  # Of these we only seperate modified and error...
  lassign $args dir han dublets
  foreach lr {left right} {
    if {$glob(notify_id,$lr) == $dir} {
      foreach {type file} $dublets {
	set key [string index $type 0]
	if {$key == "m"} {
	  lappend glob(n_files,$lr) $file
	} elseif {$key != "e"} {
	  lappend found $lr
	  if {$key == "a" && [capture $ou] == 1 } {
	    proc capture { note } { }
	  }
	} else {
	  # We have an error, shut down the whole thing
	  notifywatch remove $dir
	  return -code error "Directory modify monitor error $file"
	}
      }
    }
  }
  doInotifyUpdate $found
}
############################### End of notify code ################
############################### build Tree stub    ################
proc buildTree {args} {}
############################### End of Tree stub   ################

############################### displays setup     ################
# Here we gather info on attached displays and hidden space in the
# windows (borders and titles).
#
namespace eval ::displays {
  # monitors is set at config time... don't change it
  variable monitors
}
package require registry
proc ::displays::init {} {
  # we use the registry to get the border info.  As near as we can tell the
  # title bar is composed of a "Caption" and a border. The "CaptionHeight",
  # "BorderWidth" and "PaddedBorderWidth" are all in the below referenced
  # registry key. The values are in "twips" which is a physical length and so
  # depends on DPI (aka "AppliedDPI") for its translation.
  # A twip is 1/1440 of an inch.
  # The height we calculate below is the Caption height + the PaddedBorderWith
  # (top and bottom of the title bar) + BorderWidth (bottom of window border)
  # We negate the constant since MSW keeps these as negative quanities.
  
  set key [file native {HKEY_CURRENT_USER/Control Panel/Desktop/WindowMetrics}]
  lassign {0 0} ::displays::monitors(height) ::displays::monitors(width)
  # First get the borders
  # If there is a problem with the registry (like in wine) we default to 0
  catch {
    foreach item {AppliedDPI BorderWidth PaddedBorderWidth CaptionHeight} {
      set $item [registry get $key $item]
    }
    set ::displays::monitors(height) [expr {($CaptionHeight + \
						 $BorderWidth +\
						 2 * $PaddedBorderWidth) *\
						$AppliedDPI / -1440}]
    set ::displays::monitors(width)  [expr {2 * $BorderWidth * $AppliedDPI / -1440}]
  }
  set ::displays::monitors(monitors) {}
  foreach display [twapi::get_multiple_display_monitor_info] {
    array set tmp $display
    lassign $tmp(-workarea) xmin ymin xmax ymax
    lappend ::displays::monitors(monitors) [list $xmin $xmax $ymin $ymax]
    array unset tmp
  }
  Log "Monitors found: [array get ::displays::monitors]"
  return 
}
# For MSW we do this now. It is fast and this means we don't have to save it
# in the config file
::displays::init
############################### end of displays setup ################


# fileNameTranslate returns a list of doublets in a format suitable for 
# 'array set'..  The following will only be present if needed:
#
# scheme {file nfs cifs}
# path   for file -$sfile, for nfs target file, for cifs part of $sfile to add
#                                                        to share location
# host   for file not needed, for nfs|cifs host ip 
# user   for file not needed, for nfs|cifs user used in fstab
#
# share  only for nfs & cifs the share name (host:/??) or (//host/???)
# If a vaue is unknown it will be {}.
proc fileNameTranslate {sfile} {
  set localLetter [string range $sfile 0 1]
  # This will throw an error for a local drive
  if {[catch {twapi::get_client_share_info\
		  $localLetter\
		  -remoteshare\
		  -user} shareData] == 0} {
    set scheme "cifs"
    array set tmp $shareData
    set share [regsub -all {\\} $tmp(-remoteshare) {/}]
    return [list path [string range $sfile 1 end]\
		share  $share\
		host $hostname \
		user tmp(-user)\
		scheme cifs\
		pwd cifs://$tmp(-user)@[string range $share 2 end]]
  } else {
    return [list path $sfile scheme file]
  }
}


proc setWinVolLetter {} {
}
