#<20240109.1800.13>
#
# This module contains bits of filerunner that are pure unix
# 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 "Begin platform setup"

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

proc load_now_unix_fr_bits {} {}

# This is the turn on setup unique to this platform

namespace eval scratch {}

set ::Elevated 0
set glob(os) Unix
set ::MSW 0
set ::IsWSL [file exists /etc/wsl.conf]
set ::CASEops {}
set OS $tcl_platform(os)
set wslMap {}

# here we set up info on the Windows Subsystem for Linux a.k.a wsl
namespace eval scratch {
  set ::WSLname "<unknown>"
  proc ::scratch::wslSetUp {} {
    if {$::IsWSL} {
      # if wsl, which?
      if {[catch {split [read [set pd [open "/etc/os-release" r]]] \n} lns] == 0} {
	# lets look for a type/name
	close $pd
	foreach ln $lns {
	  if {[string match {NAME=*} $ln] || [sting match {ID_LIKE=*} $ln]} {
	    set pos [string range $ln [string first "=" $ln]+1 end]
	    set pos [regsub -all {\"| } $pos {}]
	    set pos [string tolower $pos]
	    foreach post {forwsl linux} {
	      if {[set pre [string last $post $pos]] != -1} {
		set pos [string range $pos 0 $pre-1]
	      }
	    }
	    set pos [lindex $pos 0]
	    break
	  }
	}
	# pos may not be the full name...
	if {[catch {exec wslconfig.exe /l} lns] == 0} {
	  set lns [split [encoding convertfrom unicode $lns] \n]
	  foreach ln $lns {
	    if {[string match "$pos*" $ln ]} {
	      set ::WSLname [lindex $ln 0]
	      break
	    }
	  }
	}
      }
    }
  }
}
if {$::IsWSL} {
  ::scratch::wslSetUp
}

# set ::TMP [expr {[info exist ::env(TMPDIR)] ? $::env(TMPDIR) : \
# 		     [info exists ::env(TMP)] ? $::env(TMP) : "/tmp"}]
#  puts "test if linux"
switch -nocase -glob $tcl_platform(os) {
  *cygwin* {
    set glob(cygwin) cygwin
  }  
  default {}
}
set glob(orgTitle) [wm title .]

# set up the task-bar and title bar icon

# we need to find the icon we want to use.
# If we are running from the 'tar unpack' it will be in glob(lib_fr)/icon
# If we are installed, we look in the uninstall file to find it.
proc buildTbarIcon {} {
  global glob
  # set r [catch {package require img::png}]
  # if {$r != 0} {
  #   LogSilent "tcl/tk package img::png not found. This is shipped \
  #            \nby your distro as either tkimg or lib-tkimg."
  #   return
  # }
  set iconFile $glob(lib_fr)/icons/filerunner-32x32.png
  if {![file exists $iconFile]} {
    set iconFile {}
    if {[file exists $glob(lib_fr)/uninstall]} {
      set un [read [set fid [open $glob(lib_fr)/uninstall r]]]
      close $fid
      set pat "32x32/apps/filerunner.png"
      set end [string first $pat $un]
      set first [string last " " $un $end]
      set iconFile [string range $un $first+1 $end-1]/$pat
    }
  }
  if {![file exists $iconFile] ||\
	  [catch {wm iconphoto . -default\
		      [image create photo fricon -file $iconFile]}] != 0} {
    frputs iconFile
    LogSilent "Failed to create taskbar/title icon"
  }
}


proc cleanTmpFiles {} {
  global glob 
  # We are agressive about cleaning up our tmp dir
  set mypid [pid]
  set glob(tmpdir) $glob(conf_dir)/tmp$mypid
  if {![file isdirectory $glob(tmpdir)]} {
    if {![file exists $glob(tmpdir)]} {
      set r [Try { file mkdir $glob(tmpdir) } "" 1]
      if {$r != 0} {
	PopError [_ "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 in {{} $mypid}} {continue}
    if {[catch {exec ps -p $who --no-headers} r] != 0 || $r == {}} {
      file delete -force $glob(conf_dir)/tmp$who
    }
  }
  # Try ::scratch::wslSetUp -a
}
# The unix/linux kill function...
#
#
# This bit of code is mainly to overcome the need for TclX which is
# is optional...

# The missing piece is a function to kill a process by pid. With no function
# we must use a program.

# We will use the TclX call:
#
#   kill ?signal? idlist    (note we do NOT handle -pgroup, or rather we
#                            ignor it.)
#
# The first thing one should do is call the killInit routine below.
# It will set up the proper kill call
proc killInit {} {
  set killProcs {kill -s 9 %s}
  # the prefered way...
  if {[info command kill] != {}} {return}
  set r [catch {package require Tclx}]
  if {$r == 0} {return 0}
  # ok, no Tclx. The only option left is to call the kill program
  # redefine kill to do so...
  if {[set killCode [auto_execok kill]] != {}} {
    proc kill {args} {
      foreach pid $args {
	if { [string index $pid 0] == "-"} {continue}
	exec {*}$killCode -9 $pid
      }
    }
    return {}
  } else {
    proc kill args {error "No kill function or program found."}
    return "Because a \"kill\" function was not found an attempt was\
            \n made to set up a program to replace this functionality.\
            \nHowever the \"kill\" program was not found.\
	    \nThis means the stop button will not work. Please attempt\
	    \nto install either the tcl package Tclx (which implements\
	    \na kill funtion\) or the \"kill\" program to fixthis problem.\
            \nBecause this file now exists in your \".fr\" directory, 
	    \nyou will not see this message again."
  }
}

# Here we add platform dependent buttons for the middle list.
# format is the same as in fr.
# chmod is used in windows for VFS ftp stuff
# set chmod { {Chmod}     CmdChmod h 1 \
# 		{[_b "Change the mode flags for selected file(s)." ]} } 

# foreach platformButton [list $chmod] {
#   if {[lsearch -exact -index 0 $glob(cmds,list) [lindex $platformButton 0]] == -1} {
#     lappend glob(cmds,list) $platformButton
#   }
# }
########################## end of general platform set up ##################

################################# inotify code for unix ################
proc inotifySetUp {} {
  global glob

  set inotifySo [glob -nocomplain -path $glob(lib_fr)/packages/inotify/ "*.so"]
  if {$inotifySo == {}} {
    # This could be the first run in a tar unarch area, if so see if we have 
    # what is needed...
    set platform $::tcl_platform(machine)
    if {[file exists $glob(lib_fr)/packages/inotify/$platform/pkgIndex.tcl]} {
      foreach fl [glob -nocomplain -tails\
		      -path $glob(lib_fr)/packages/inotify/$platform/ "*"] {
	# Use a relative link so we can rename fr's location
	file link $glob(lib_fr)/packages/inotify/$fl $platform/$fl
	if {[file extension $fl] == ".so"} {
	  set inotifySo $glob(lib_fr)/packages/inotify/$fl
	}
      }
    }
    set inotifySo [glob -nocomplain -path $glob(conf_dir)/ "libinotify*.so"]
  }
  # if {$inotifySo != {} && [catch "load $inotifySo inotify" out] == 0 ||\
      # 	    [catch {package require inotify} out] == 0} {}
  if {($inotifySo == {} || [catch "load $inotifySo inotify" out] != 0) &&\
	  [catch {package require inotify} out] != 0} {
    # inotify Not Found...
    if {![file exists $glob(conf_dir)/inotify-message]} {
      set r [catch {open $glob(conf_dir)/inotify-message w} fid]
      if {$r != 0} { 
	PopError "Saving $glob(conf_dir)/inotify-message: $fid"
	return "" 
      }
      set ship [glob -nocomplain -tails -type d\
		    -path $glob(lib_fr)/packages/inotify/ "*"]
      if {$ship == {} && [file exists $glob(lib_fr)/shipInotifyArchs]} {
	source $glob(lib_fr)/shipInotifyArchs
	if {[info exists ::shipInotifyArchs]} {
	  set ship $::shipInotifyArchs
	}
      }
      set inot \
	  [lindex [lsort -decreasing \
		       [glob -nocomplain -tails -directory\
			    $glob(lib_fr)/Makefiles tcl-inotify-*]] 0]
      puts $fid [_ "Filerunner set up has failed to find a usable tcl inotify\
      library.\n\n" ]
      if {$inotifySo == {} } {    
	puts $fid [_ "Your arch is not one of the ones supported by filerunner as\
      shipped and you have yet to build an inotify package (as described below)\
      and an attempt to load the inotify package from the system area resulted\
      in error: \"%s\"" $out]
      } else {
	puts $fid [_ "Filerunner encoutered error: \"%s\"\n\
      attempting to load: \"%s\"" $out $inotifySo]
      }
      puts $fid [_ "\
      \nThe inotify feature is optional and if no further action is taken this\
      message will not be repeated."]
      puts $fid [_ "\
      \nFilerunner is shipped with the\n\
      %s\
      \nversions of this library.\n" $ship ]
      puts $fid [_ "If you are running on some other architecture and want to\
      use the\
      inotify feature you will have to build the required library.  To do\
      this, you will need the following development packages installed on \
      your system:

      tcl-devel
      gcc       (or some other C compiler)
      make
      
      There are two approaches you may use to install inotify:
      1.) For just this user of filerunner:
          a.) Navigate to %s using file runner or your
              favorite shell.
          b.) Execute the program/script 'build-inotify' 
               (in filerunner open the command window and type:
               './build-inotify' or in your shell, type the same thing.)
          c.) If the command completes with 'Success', you are done.
              If not, you should have an error message indicating what went
              wrong (most likely a missing tool).

       This puts the inotify files 'pkgIndex.tcl & libinotify*.so' in the
       users .fr directory (~/.fr) where filerunner will find them. You
       may copy them to other users .fr directories if desired.

       2.) For all users on the system (you will need to have root access):
           a. In filerunner navigate to %s
           b. In the opposite panel navigate to an empty directory you will
              use to build the inotify code.
           c. Select the file %s
           d. Click the middle button 'UnArc'
           e. In you favorite shell, navigate to the sub directory that
              step c creates under your empty directory.  The simple
              build is:

              $ ./configure
              $ make
              su
              > make install
              > exit

      './configure --help' gives a whole LOT of extra info if you need it.      

      Inotify is optional and not even available on non-linux systems.\n\n\
      You do NOT need to install it.\n\
      \nThis message is in the file %s. \
      \nOnce inotify is correctly installed you may delete this file.\
      If you delete this file and inotify is not found on the next start up\
      of filerunner, this file will be recreated and displayed. (Thus a\
      test for correct installation of inotify is to delete this file.)\
      If you install it and filerunner does not find it you can look at\
      where filerunner looks by opening a command window in filerunner and\
      typing '%% set auto_path'  This will show where it is looking so you can\
      put the package there.  You can change the install location (method 2)\
      by using the '--prefix' argument in the 'configure' command when \
      building inotify, i.e. ./configure --prefix=/usr/lib\n\n\
      This message may also be seen via the Help menu (Help->inotify)" \
		     $glob(lib_fr)/Makefiles $glob(lib_fr)/Makefiles \
		     $inot $glob(conf_dir)/inotify-message ]
      puts $fid [_ "\nIf you do build an inotify, consider sending it to the author\
     (see the About.. info under the File menu) for inclusion in the next release.\
     Please include the platform name (%s) along with the *.so file.\n\n" \
		     $::tcl_platform(machine)]
      close $fid
      ViewText $glob(conf_dir)/inotify-message
     }

    return
  } ; # End of the not found code for unix systems...
  set r [inotify create notifywatch notecallback]
  frputs  r
  
}   ; # End of the unix version set up

# some unix only stuff...
proc GetUidGidString { file uid gid } {
  global glob users groups
  
  if { ![info exists users($uid)] ||\
	   ![info exists groups($gid)] } {
    # Need to work for it...
    if { [catch {file attributes $file} gu] != 0 } {
      # rare but happens with dead links...
      return ""
    }
    #set gu [file attributes $file]
    set users($uid) [lindex $gu 3]
    set groups($gid) [lindex $gu 1]
  }
  return "$users($uid)/$groups($gid)" 
}

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

proc GetDF { dir } {
  # Makes a stab at getting the full size of the disk
  global glob
  #frputs "in getdf " dir
  set mp {}
  set r [catch {exec df $dir} out]
  set oout [split $out]
  set indx [lsearch -regexp $oout {[0-9]%}]
  if { $indx != -1 } {
    set mp [lindex $oout $indx+1]
    incr indx -1
    while {[set free [lindex $oout $indx]] == "{}" } {
      incr indx -1
    }
  } else {
    set free ""
  }

  return [list [formatDF $free] $mp]
}

proc notecallback {args} {
  global glob config
  set did 0
  set found {}
  # the linux code
  while {[$glob(notify,watchname) queue]} {
    set out [$glob(notify,watchname) read]
    # watchname read returns 'ID id Flag flags Cookie cookie File file'
    # where the capital element is fixed and the lower case is the var.
    # For windows the Flag info is: 'ID pairs' where pairs are:
    frputs out
    foreach ou $out {
      set file [lindex $ou 7]
      set reason [lindex $ou 3]
      set lr [expr {$glob(notify_id,left) == \
			[lindex $ou 1] ? {left} : {right} }]
      if {$file != {} } { 
	if { $reason == "n" } {
	  if { [capture $ou] == 1 } {
	    proc capture { note } { }
	  }
	}
	if {[string first $reason "rwaCco"] != -1 } {
	  lappend glob(n_files,$lr) $file
	} else {
	  lappend found $lr
	  if { $reason == "f"} {puts "inotify queue overflow"}
	}
      }
    }
  }
  doInotifyUpdate $found
}
########################### End of inotify code #######################

########################## The Tree button ############################
# tcl/tk for windows does not support the cascade needed do do the tree
# So, we put the code only in the unix version
#
proc buildTree {wf inst} {
  global glob
  menubutton $wf.dir_but -takefocus 0 -menu \
      $wf.dir_but.m -direction right\
      {*}[getImage -bitmap tree @$glob(lib_fr)/bitmaps/tree.bit]
  bind $wf.dir_but <Motion> {+
    if {$::tk::Priv(postedMb) == "%W"} {
      set ::tk::Priv(menuActivated) 1
    }
  }
  balloonhelp_for $wf.dir_but \
      {[_b "Directory tree scan." ]}

  menu $wf.dir_but.m  \
      -tearoff false -postcommand  "CdMenuCreate \
      ${inst} \$glob($inst,pwd) \
      $wf.dir_but.m 1"
  # -font $glob(gui,GuiFont) 
  grid $wf.dir_but     -row 1 -sticky ew -column 0

}

# The cascade menu. Does NOT work on windows.

proc CdMenuCreate { inst curdir menuwid level } {
  global glob config
  #puts "CdMenuCreate curdir: \'$curdir\'"
  if { [string range $curdir 0 1] == "//" } {
    set curdir [string range $curdir 1 end]
  }
  if { [IsVFS $curdir] } {
    set curdir /
  }
  set r [catch {cd $curdir} outp]
  if {$r != 0} {
    $menuwid delete 0 end
    if { [IsVFS $curdir] } {
      $menuwid add command -label [_ "Not implemented for VFS"]
    } else {
      $menuwid add command -label $outp
    }
    return ""
  }
  set r [catch {pwd} curdir]
  if {$r} {
    $menuwid delete 0 end
    $menuwid add command -label $curdir
    return ""
  }
  # glob needs an && function to pick up hidden && d (or hidden && -hidden)
  set r [catch {glob  -nocomplain */} outp]
  if {$r} {
    $menuwid delete 0 end
    $menuwid add command -label $outp
    return ""
  }
  if {$config(fileshow,all)} {
    set r [catch {glob -type {hidden d} -nocomplain *} outp2]
    if {$r} {
      $menuwid delete 0 end
      $menuwid add command -label $outp
      return ""
    }
    foreach d $outp2 {
      lappend outp $d/
    }
  }
  set menulist [lsort $outp]
  if {!$config(fileshow,all)} {
    set menulist [linsert $menulist 0 ..]
  }
  $menuwid delete 0 end
  if { $level == 1 } { 
    $menuwid add command -label / -command "CdMenuCommand $inst /"
  }

  foreach dir $menulist {
    #puts "Adding cdmenucommand $curdir/$dir"
    $menuwid add command -label $dir -command \
	"CdMenuCommand $inst [list $curdir/$dir]"
  }

  bind $menuwid <Map> \
      "CdMenuCreateCasc $inst [list $curdir] %W $level [list $menulist]"
  bind $menuwid <Unmap> { %W.0 unpost }
}

proc CdMenuCreateCasc { inst curdir menuwid level menulist } {
  global glob config
  #puts "CdMenuCreateCasc curdir: \'$curdir\'"
  set n 0
  if {[winfo exists $menuwid.0]} {
    destroy $menuwid.0
  }
  menu $menuwid.0 -tearoff false
  # -font $glob(gui,GuiFont)

  if {$level == 1} {
    if {[winfo exists $menuwid.0.$n]} {
      destroy $menuwid.0.$n
    }
    menu $menuwid.0.$n -tearoff false -postcommand\
	"CdMenuCreate $inst / $menuwid.0.$n [expr $level+1]"
    # -font $glob(gui,GuiFont)
    $menuwid.0 add cascade -menu $menuwid.0.$n
    incr n
  }
  foreach dir $menulist {
    if {[winfo exists $menuwid.0.$n]} {
      destroy $menuwid.0.$n
    }
    menu $menuwid.0.$n -tearoff 0 -postcommand\
	"CdMenuCreate $inst [list $curdir/$dir] $menuwid.0.$n [expr $level+1]"
    # -font $glob(gui,GuiFont)
    $menuwid.0 add cascade -menu $menuwid.0.$n
    incr n
  }
  $menuwid.0 post [expr \
		       [winfo rootx $menuwid] + \
		       [winfo width $menuwid] - \
		       26] [winfo rooty $menuwid]
}

proc CdMenuCommand { inst dir } {
  global glob config
  #puts "CdMenuCommand dir \'$dir\'"
  destroy $glob(win,$inst).dirmenu_frame.dir_but.m
  menu $glob(win,$inst).dirmenu_frame.dir_but.m -tearoff false \
      -postcommand \
      "eval CdMenuCreate $inst \[list \$glob($inst,pwd)\] \
      $glob(win,$inst).dirmenu_frame.dir_but.m 1"
  # -font $glob(gui,GuiFont)
  #update idletasks
  DoProtCmd "NewPwd $inst [list $dir] ; UpdateWindow $inst"
}
################################# End of Tree menu create #############
#
################################# Begin of displays::init  #############

# Here we attempt to gather info on attached displays
# This code depends on xrandr being available to query the display system
#
namespace eval ::displays {
  # monitors is set at config time... don't change it
  variable monitors
  variable percent 10
}

# The following code, while it does the right thing, takes too long
# to do it. To make this time somewhat invisible to the user we put
# in breaks (using realWaitForIdle). For this to work as intended
# the following function should be run from an after script, i.e.:
# after 0 ::displays::init

# Implemtation issues:
# What we want is a description of the available workarea on each
# monitor. We can easily get this on MSW via twapi. But for X11,
# no such luck. In fact Tk does not recognize monitors and only
# as an artifact of fullscreen or zoom what the actual workarea
# is. The attempt here is to use xwininfo to get the desired info.
# Since xrandr does not tell us about "dock"ed windows which take
# away from the workarea while xwininfo does, we try to get all
# the info frome xwininfo. We note, however, in some cases a monitor will
# not have a "desktop" window (this seems to occur when a monitor is
# added after the initial X set up). When we detect this we will
# use xrandr to attempt to find the missing monitor(s). We note,
# however, that some systems do not automatically install xrandr
# (raspbian is such). We, therefor have a couple of fall backs:
# If neither xwininfo nor xrandr can not be found, we use tk winfo to
# get screen info (we have found this to be wrong as well, but what
# can we do?). If xwininfo comes up with a root window bigger than
# the accumulate monitors, we first try xrandr to fill in the
# missing info. If that fails, we try to compute the missing
# monitor size and location (but there may be more than one AND
# monitors are not required to have no space between them).

# xwininfo seems to be more universally shipped,
# and it gives info on docked windows which allows us to reduce the
# monitor workarea to account for the docked windows (task bars, panels
# etc.).
#
# Some issues:
# 1. It appears that in cases where a system monitor is disconnected or
#    otherwise disabled and then re-enabled, X appears to loose track of
#    the "Desktop" window.
# 2. The "-tree" option lists far too many useless windows AND does not
#    include the wm hints as to it being a Desktop or Dock window. This
#    means we need to run xwininfo for each window we suspect of being such.
#
# We address the second problem by trying to prune as many useless windows
# as we can. The current criteria we use is indentation in the tree (i.e.
# level), name (must have one) and not a 1x1 window.

#
# This command gets xranr display info and returns a list of monitors
# All notation used in results (and internally) is {xmin xmax ymin ymax}

# proc getXranrInfo {xrandr} {
#   set info [exec $xrandr --display $::env(DISPLAY) -q]
#   set r {}
#   foreach line [split $info \n] {
#     if {[regexp {.* connected.* ([0-9]+)x([0-9]+)\+([-0-9]+)\+([-0-9]+) .*}\
# 	     $line duh w h x y]} {
#       lappend r [list $x [expr {$x + $w -1}] $y [expr {$y + $h -1}]]
#     }
#   }
#   return $r
# }

# Take II
# Here we still use xrandr and xwininfo but much more sparingly.
# If xrandr exists we use it to find the monitors, if not we
# assume there is only one monitor.



# We only use xwininfo to get the standard border information
# This should mean we only make one call.

# Here is the wait command. It is called when config changes
# This code sets ::displays::found when it is called and
# the width, height, x and y all differ from the pattern versions
# (::displays::pat{w h x y}

# proc ::displays::config {w h x y} {
#   foreach whxy {w h x y} {
#     lappend ::displays::d::foundH [list ${w}x${h}+${x}+$y [wm geo $::displays::d::w] $::displays::d::failsafec]
#     if {[set $whxy] == [set ::displays::d::pat$whxy]} {return}
#   }
#   set ::displays::d::found ${w}x${h}+${x}+$y
# }

# The zoom/normal code differs in Linux/Darwin. Here we do the right thing
# given window 'w' and option set (nil -> return state, 1 -> zoom, 2 -> normal

proc ::displays::wmZoomW {w {set {}}} {
  variable Ux [expr {$::tcl_platform(os) != "Darwin"}]

  if {$Ux} {
   if {$set != {}} {
      wm att $w -zoomed [expr {$set}]
      return
    }
    return [wm att $w -zoomed]
  }
  # Darwin code
  if {$set != {}} {
    wm state $w [expr {$set ? "zoomed" : "normal"}]
    return
  }
  return [expr {[wm state $w] == "zoomed"}]
}


# This functions zooms the window "w" and then waits for it
# to settle.

proc ::displays::wmZoomWait {w } {
  # foreach var {w patw path patx paty found foundH failsafec} {
  #   upvar #0 ::displays::d::$var $var
  # }
  variable failsafec
  # It is not uncommon for this to take a while
  set maxWait 100
  # lassign [split [set geo [wm geo $w]] x+] patw path patx paty
  set failsafec 0
  wmZoomW $w 1
  while {[incr failsafec] < $maxWait && \
	     ![wmZoomW $w]} {
    # frputs "[wmZoomW $w] [wm geo $w] " 
    realWaitForIdle
  }
  realWaitForIdle
  # frputs failsafec "[wm geo $w] "  "[wm $op $w $subOp] " 
  return [expr {$failsafec < $maxWait ? 0 : $failsafec}]
}

# Here is the init code. We want to find the working area of each
# monitor and also the normal border sizes on top level windows.

# Take III
# Here we want to rid ourselves of the xrandr connection.  While it
# may not be needed on a system with a single monitor, to allow said
# system to use a remote X display, we would still need xrandr on the
# simple system.
# Here we use xwininfo, but only to get the parents borders.
#
# Here is what we do.
# First we know that any monitors we want will be within what Tk
# calls the "screen", so we use those boundries to tell us when to
# stop. We start at "screen" minx and miny and use zoom to take
# bites out of the "screen" until, I hope, we have all the monitors.
# We will use a recursion to examine 3 points around each corner of
# each monitor we find. This way we even find screens that are
# composed of two diagonally arrange monitors.
# We will assume being X percent or less from an expected boundry
# is actually at the boundry (i.e. docked windows should not be
# bigger than X percent of the display.

# First a routine to test if a given location is in a given area.
# "this" is {x y} and that is {minx maxx miny maxy}

proc ::displays::isIn {this that} {
  lassign $this tx ty
  lassign $that aminx amaxx aminy amaxy
  return [expr {$tx >= $aminx &&\
		    $tx <= $amaxx &&\
		    $ty >= $aminy &&\
		    $ty <= $amaxy}]
}

proc ::displays::isInGeo {this geo} {
  lassign [split $geo x+] w h x y
  lassign $this tx ty
  return [expr {$tx >= $x && $tx < ($x + $w) &&\
		    $ty >= $y && $ty < ($y + $h)}]
}

# "inScreen" checks if "this" {x y} is in the "screen"

proc ::displays::inScreen {this} {
  return [isIn $this $::displays::d::screen]
}

# "inFound" looks to see if "this" {x y} is in one of the
# found monitors.
proc ::displays::inFound {this} {
  foreach mon $::displays::d::newmon {
    if {[isIn $this $mon]} {return 1}
  }
  return 0
}
# foundIn checks if <new> contains anything in one of the found
# if so it replaces the one in found with new.
# A return of 0 indicates that only part of the old window was in the new
#             1 indicates the whole of the old was in the new
#             2 indicates that there was no part of an old in the new
# ! hint ! a 0 return would indicate, in general, that the routine is broken
proc ::displays::foundIn {new} {
  set index -1
  foreach mon $::displays::d::newmon {
    incr index
    lassign $mon fxmin fxmax fymin fymax
    if {[isIn [list $fxmin $fymin] $new]} {
      set ::displays::d::newmon [lreplace $::displays::d::newmon $index $index $new]
      set rt [isIn [list $fxmax $fymax] $new]
      frputs $rt new mon
      return $rt
    }
  }
  return 2
}
# This is the recursive check to see if we:
# a.) "this"  point is in the "screen",
# b.) and is not in an already found monitor
# c.) if a.) and b.) are true put a small window ("w")
#     at "this" location and zoom it.
# d.) if the result is an area that is not in a "found"
#     monitor and if it is totally in the screen we add it
#     to the found list.
# If all the above is true, we compute the x & y locations of
# 3 points at each corner of the found monitor but "x" percent
# away and recur for each computed point. Most of the new points
# will fail test a.) or b.).

proc ::displays::getMons {this} {
  variable percent
  variable Ux [expr {$::tcl_platform(os) != "Darwin"}]
  
  foreach var [info vars ::displays::d::*] {
    upvar #0 $var [namespace tail $var]
  }
  set limit 10
  lassign $this x y
  frputs this "inscreen [inScreen $this] in found [inFound $this] "
  if {![inScreen $this] || [inFound $this]} {return 1}
  set mfailsafe 0
  if {[incr recurlimit -1] <= 0} {
    frputs recurlimit
    return 0
  }
  while {[incr mfailsafe] < $limit} {
    set failsafe 0
    wmZoomW $w 0
    realWaitForIdle
    # 
    set geo ${minWin}+${x}+${y}
    wm geo $w $geo
    while {([wm geo $w] != $geo || [wmZoomW $w]) && [incr failsafe] < $limit} {
      wmZoomW $w 0
      set lm 0
      while {[incr lm] < $failsafe * 10} {
        realWaitForIdle
        wm geo $w $geo
        realWaitForIdle
      }
    }
    frputs failsafe "[wm geo $w] [wmZoomW $w] " geo
    if {$failsafe >= $limit } {continue}
      
    if {[wmZoomWait $w] == 0} {
      frputs failsafe "[wm geo $w] "
      if {$failsafe >= $limit} {continue}
      break
    }
  }
  if {$mfailsafe >= $limit} {
    frputs mfailsafe
    # wm att $w -zoomed 0
    return 0
  }
  lassign [split [wm geo $w] x+] wmW wmH minX minY
  lassign [split [winfo geo $w] x+] winfoW winfoH winfoX winfoY
  # wm att $w -zoomed 0
  if {$minX != $winfoX} {
    # There is a full frame, use wm and add the frame
    set maxX [expr {$wmW + $minX + $bdW - 1}]
    set maxY [expr {$wmH + $minY + $bdH - 1}]
  } else {
    # Not a full frame, possible title, use winfo to account for title
    set maxX [expr {$wmW + $winfoX - 1}]
    set maxY [expr {$wmH + $winfoY - 1}]
  }
  # make sure it not one we already have
  # and it is fully in the screen
  frputs newmon minX maxX minY maxY
  if {![inFound [list $minX $minY]] && \
	  [inScreen [list $minX $minY]] &&\
	  [inScreen [list $maxX $maxY]]} {  
    switch [foundIn [list $minX $maxX $minY $maxY]] {
      0 {frputs;return 0}
      2 {
	lappend newmon [list $minX $maxX $minY $maxY]
      }
    }
    frputs newmon
    # This is just a bunch of math, so it should be fast...
    # we probe from each corner going "percent" in each direction.
    # This gives us 12 points to probe.
    # set Xpercent [expr {((($newmaxX - $wmX) * $percent) / 100)}]
    # set Ypercent [expr {((($newmaxY - $wmY) * $percent) / 100)}]
    # set XminMinus [expr {$wmX - $Xpercent}]
    # set XminPlus  [expr {$wmX + $Xpercent}]
    # set XmaxMinus [expr {$newmaxX - $Xpercent}]
    # set XmaxPlus  [expr {$newmaxX + $Xpercent}]
    # set YminMinus [expr {$wmY - $Ypercent}]
    # set YminPlus  [expr {$wmY + $Ypercent}]
    # set YmaxMinus [expr {$newmaxY - $Ypercent}]
    # set YmaxPlus  [expr {$newmaxY + $Ypercent}]
    #
    # This computes the above...
    foreach XY {X Y} {
      set XYpercent [expr {((([set max$XY] - [set min$XY]) * $percent) / 100)}]
      foreach minmax {min max} {
	set ${XY}${minmax}Minus [expr {[set ${minmax}$XY] - $XYpercent}]
	set ${XY}${minmax}Plus  [expr {[set ${minmax}$XY] + $XYpercent}]
      }
    }
    # This loop checks each point less than Xmin and greater than Xmax
    foreach xminmax [list $XminMinus $XmaxPlus] {
      foreach yminmaxpm [list $YminMinus $YminPlus $YmaxMinus $YmaxPlus] {
	if {![getMons [list $xminmax $yminmaxpm]]} {return 0}
      }
    }
    # Here we do the points less than Ymin or more than Ymax
    # that were not done above.
    foreach yminmax [list $YminMinus $YmaxPlus] {
      foreach xminmaxpm [list $XminPlus $XmaxMinus] {
	if {![getMons [list $xminmaxpm $yminmax]]} {return 0}
      }
    }
  } else {
    frputs "[inFound [list $minX $minY]] [wm geo $w] " newmon
  }
  return 1
}

proc ::displays::init {} {
  variable percent
  variable monitors
  # Lets use a private little data area
  namespace eval d {
    # variable patw 0
    # variable path 0
    # variable patx 0
    # variable paty 0
    # variable found
    variable last 1x1+0+0
    variable screen {}
    variable newmon {}
    variable w
    variable bdW
    variable bdH
    variable recurlimit 10
    variable minWin 200x200
    variable subOp
    variable failsafec 0
  }
  set foc [focus]
  frputs !! foc
  foreach var [info vars ::displays::d::*] {
    upvar #0 $var [namespace tail $var]
  }
  # set the "screen" in a local var in our format
  # i.e. {xmin xmax ymin ymax}
  set screen [list 0 [expr {[winfo screenwidth .] - 1}] \
		  0 [expr {[winfo screenheight .] - 1}]]
  # if xwinfo, lets get the border
  lassign [split [wm geo .] x+] dotW dotH dotX dotY
  if {[set xwinfo [auto_execok xwininfo]] == {}} {
    # No xwinfo
    lassign [split [winfo geo .] x+] duh duh winfoDotX winfoDotY
    # This assumes left and right border are the same
    set bdW [expr {($winfoDotX - $dotX) * 2}]
    # The subtraction give the title bar height, assume the
    # bottom border is twice the size to allow mice to find it.
    set bdH [expr {($winfoDotY - $dotY) + $bdW}]
  } else {
    # "xwinfo" exists, ask it about "."s parent window on the
    # current display.
    set r [catch {exec $xwinfo -id [wm frame .]\
		      -display $::env(DISPLAY)} wminfo]
    foreach line [split $wminfo \n] {
      #frputs line x y width height
      switch -regexp -matchvar match $line {
	    { *Width: +([0-9]+)} {set w [lindex $match 1]}
	    { *Height: +([0-9]+)} {set h [lindex $match 1]
	      break}
      }
    }
    set bdW [expr {$w - $dotW}]
    set bdH [expr {$h - $dotH}]
  }
  # set this up for all to use.
  set ::displays::monitors(width) $bdW
  set ::displays::monitors(height) $bdH
  set w .monitor_size_probe
  destroy $w
  toplevel $w
  # this keeps the flicker in the +0+0 corner
  wm geo $w 200x200+1+1
  # go dark (well invisible)
  # for reasons unknown, we need to repeat this
  # We can not check for success as some systems do not support.
  wm att $w -al 0.0
  realWaitForIdle
  wm att $w -al 0.0
  realWaitForIdle
  frputs  "[wm att $w -al] [focus] " foc
  # bind $w <Configure> "::displays::config %w %h %x %y"
  # For reasons we do not understand, wm may not allow a window as
  # small as requested. Check what it did allow and go with that.
  lassign [split [wm geo $w] x+] width heigh
  set minWin ${width}x${heigh}
  while {[incr failsafe] < 10} {
    frputs minWin failsafe
    # The following zoom fixes an occasional lockup in getMons
    wmZoomW $w 1
    set newmon {}
    # We start with a point x percent into the 0,0 location
    if {[getMons [list [expr {([winfo screenwidth .] * $percent) / 100}]\
		      [expr {([winfo screenheight .] * $percent) / 100}]]] && \
	    $newmon != {}} {
      break
    }
    realWaitForIdle
  }
  wm transient $w .
  focus -force $foc
  destroy $w
  #wm focusmodel . active
  # grab set -global $foc
  # focus -force .
  # focus -force $foc
  # frputs foc ">[focus]< "
  # grab release $foc
  # if all this failed...
  # focus -force .
  frputs "[focus] "
  # centerMouse2 $foc
  frputs "[focus] "
  if {$failsafe >= 10} {
    LogSilent "Found displays $newmon, but not reliable. Making no changes"
    frputs !!- 
    return [list Failed $newmon $failsafe]
  }
  set ::displays::monitors(monitors) $newmon
  # If this is a new or different result, flush it to the config file...
  foreach ent $::config(monitors) {
    array set mons $ent
    if {![info exists mons($::env(DISPLAY))]} {
      lappend newMons $ent
      continue
    }
    # something exists for this display
    array set test $mons($::env(DISPLAY))
    if {[arraysEq ::displays::monitors test]} {
      # already here, all done
      LogSilent "displays::init completed. \
         \nFound $::config(monitors) (no change).\
         \nFailsafe is $failsafe"
      frputs !!-
      return [list $::displays::monitors(monitors) $failsafe]
    }
    # Exists but differs, leave it out of the newMons
    # It will be added below
  }
  # Entry for this display does not exist,
  # either because it differed or was not found, so make it
  lappend newMons [list $::env(DISPLAY) \
		       [list monitors \
			    $::displays::monitors(monitors) \
			    width $bdW \
			    height $bdH]]
 

  LogSilent "Updating config from $::config(monitors) to $newMons Failsafe is $failsafe"
  set ::config(monitors) $newMons
  SaveConfig
  frputs !!-
  return [list $::displays::monitors(monitors) $failsafe]
 
}

################################# End of displays::init  #############


# The following bits are used by cmdrsync and others...

# 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} {
  # We do not require the file to actually exist but we do assume
  # that the path is real and on this system
  set scheme {}
  regexp -- {^([a-z0-9+.-][a-z0-9+.-]*):} $sfile dummy scheme
  #puts "$sfile $scheme"
  if {$scheme != {}} {
    # this is a url of some sort.  Not sure what to do with it...
  } else {
    set mtab "/etc/mtab"
    if {![info exists ::fileNameTranslate::mtime]} {
      namespace eval ::fileNameTranslate {
	variable maps {}
      }
    }
    set cntrl [split [read [open $mtab r]] \n]
    set ::fileNameTranslate::maps {}
    # external file systems are either <name>:* or <ip>:* or //<name>/*
    # build a list of possible mount points for external file systems
    foreach ln $cntrl {
      lassign $ln sys mp dm ops
      if {$sys == {} || [string range $sys 0 0] == "#"} {continue}
      if {[string range $sys 0 1] == "//" || [string match "*:*" $sys]} {
	#puts "$sys $mp $dm $ops"
	lappend ::fileNameTranslate::maps \
	    [list $mp $sys host [::findUNC::fileNameGetParm addr $ops] \
		 user [::findUNC::fileNameGetParm username $ops]]
      }
    }
    set ::fileNameTranslate::maps \
	[lsort -decreasing -index 0 $::fileNameTranslate::maps]

    # Here we have the control base, it is time to see if the passed in
    # file is remote
    foreach rmt $::fileNameTranslate::maps {
      # remains will be host and user
      set remains [lassign $rmt key ho host hostname user username]
 
      set keyLn [string length $key]
      if {[string compare -length $keyLn $key $sfile] == 0} {
	# this would be it, the longest match since the map is desending
	# The nfs file system is an easy translation.  The cifs, not so much.
	if {[string range $ho 0 1] != "//"} {
	  # nfs...
	  return \
	      [list path \
		   [regsub {^[^:]+:(.*)} \
			$ho {\1}][string range $sfile $keyLn+1 end] share $ho\
		   host $hostname user $username\
		   {*}$remains scheme nfs pwd $username@$hostname]
	} else {
	  return [list path [string range $sfile $keyLn+1 end] share $ho\
		      host $hostname user $username scheme cifs\
		      pwd cifs://$username@[string range $ho 2 end]]
	}
      }
    }
    # If we get here its a local file
    return [list path $sfile scheme file]
  }
}

# Here we have a couple of entries for the Utilities menu
#
namespace eval ::UtilsMenu {
  # These entries are added to the utilities menu for *nix
  variable ents {
    {-label {Refresh PATH (after add/delete programs)} -command {unset -nocomplain ::auto_execs}}
  }
}

proc setDN {mp share server target} {
  global config
  set cv {format "%s(%s)(%s)" $share $server $mp}
  if {$config(DisplayNameShare) != {}} {
    set cv $config(DisplayNameShare)
  }
  set displayName  [eval $cv]
  delDN $displayName
  # This deletes a possibly old display name with nil drive
  set mp {}
  set displayName2 [eval $cv]
  delDN $displayName2
  set r [catch {addDN  [list $target $displayName]} er]
  frputs er
  if {$r != 0 && [string index $er 0] != "-"} {
    PopWarn $er
  }
}

# Hmmm. We have two places where we may need to deal with cifs
# connections on start. Since we went to the trouble of letting
# the 'Mount VFS' command mount them, it will be wanting to sort
# out its 'currentMounts' info, especially on reboot. So, here
# lets just set up the display name based on the passed in info
# from the pass word locker.

proc setUpShare {} {
  global config
  set mess {}
  foreach ci [::pwLocker::patternGet "cifs://*"] {
    lassign $ci unc pw arg
    # since we only set up display names, just continue if the
    # flag says not to.
    set found {}
    foreach ent $arg {
      if {[string match -nocase "dn:\[nohd\]*" $ent]} {
        set found [string index $ent 3]
        break
      }
    }
    if {$found in {N n {}}} {continue}
  
    if {![IsVFS $unc] || $VFSpath == {}} {
      lappend mess "\"$unc\" is not a properly formated URL"
      continue
    }
    # build a clean share name
    set path $VFSpath
    lassign [split $VFSadd @] user VFSadd
  
    if {$VFSadd == {}} {
      # no user...
      set VFSadd $user
      set user {}
    }
    # Here we want to verify that the target mount point is right.
    #
    # we use 'findmnt' here. If it is already mounted or in fstab
    # we are good. The directory exists test should (we hope) cover
    # auto mount.
    #
    set dn {}
    frputs VFSadd path
    if {[catch {exec findmnt -n  "//$VFSadd/$path"} res] == 0 || \
	     [catch {exec findmnt -sn  "//$VFSadd/$path"} res] == 0} {
      set target [lindex $res 0]
      setDN $dn $path $VFSadd $target
    } else {
      frputs res
      lappend mess "Mount info for \"//$VFSadd/$path\" not found in\
          \"/etc/fstab\""
    }
  }
  return $mess
}
