#!/usr/local/bin/wish8.6
# -*- tcl -*-
# <20240518.1518.45>
######################################################################
#  Copyright © 2010-20** Tom Turkey  
#  Copyright © 1996-1999 Henrik Harmsen
#
# FileRunner is Free Software distributed under the 
# GNU General Public License. FileRunner comes with 
# ABSOLUTELY NO WARRANTY. 
# See menu Help/Copying (or file ../doc/COPYING.gz) for further details.
######################################################################

# Here is a simple routine to catch execute times for, well, what ever command

# The times will be put in the 'startTimes' list which may be dumped
# with 'dumpStartTimes'
# There will be an entry and exit for each (numbered so you know which entry
# an exit is for, as well as the elapsed time in microseconds.
# This code was/is mainly for start up issues, however

# The startProc is called as start passes each mile stone.
# call is: startProc 'info string'  where 'info string' is attached to
# each 'startTimes' entry along with the current time
# It is defined here as it is called by the next line...

proc startProc {who} {
  
  lappend ::startTimes [list [clock milliseconds] "$who [wm state .] [wm geo .]\
 [winfo geo .]"]
  # puts "[lindex $::startTimes end]"
  # foreach tm [after info] {
  #   puts "$tm > [after info $tm]"
  # }
  flush stdout
}

wm withdraw .
startProc "First light"

#  Copyright © 2010-20** Tom Turkey     (see var Copyright or About for latest year) 
#  Copyright © 1996-1999 Henrik Harmsen
# So we don't have to tell about the GPL again...

# proc About {} {
#   global glob
#   smart_dialog .apop[incr ::uni] .\
#       [_ "About FileRunner"] \
#       [list [_ "FileRunner version %s

#  %s

# FileRunner is Free Software distributed under the 
# GNU General Public License. FileRunner comes with 
# ABSOLUTELY NO WARRANTY. 
# See menu Help/Copying for further details.
# " $glob(displayVersion) $::Copyright]] 0 1 [_ "OK"] \
#       [list -font -Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-* \
# 	   tag {config tag -justify center} \
# 	  -borderwidth 10\
# 	   -flashon 0]
#   return
# }

# Here is a simple routine to catch execute times for, well, what ever command

# The times will be put in the 'startTimes' list which may be dumped with 'dumpStartTimes'
# There will be an entry and exit for each (numbered so you know which entry
# an exit is for, as well as the elapsed time in microseconds.
# This code was/is mainly for start up issues, however

set saveWhatEver {}
# set argv "db early"
proc setCmdTrace {whatEver} {
  if {$::saveWhatEver != {}} {
    UdoWhatEver
  }
  if {$whatEver != {}} {
    set ::saveWhatEver $whatEver
    rename $whatEver $whatEver.RealCmd
    proc $whatEver {args} {
      frputs #2 #3 #4 "Entered([set so [incr ::whatEverCount]]) $::saveWhatEver " args
      # startProc "Entered([set so [incr ::whatEverCount]]) $::saveWhatEver with args $args"
      
      set start [clock microseconds]
      # puts "Entered $::saveWhatEver with args $args"
      set RETURN [uplevel $::saveWhatEver.RealCmd $args]
      frputs #2 #3 #4 "Exit ($so time [expr {[clock microseconds] - $start}]) $::saveWhatEver " RETURN
      #startProc "Exit ($so time [expr {[clock microseconds] - $start}]) $::saveWhatEver with $RETURN"
      return $RETURN
    }
  }
}

proc UdoWhatEver {} {
  if {$::saveWhatEver != {}} {
    rename $::saveWhatEver {}
    rename $::saveWhatEver.RealCmd $::saveWhatEver
    set ::saveWhatEver {}
  }
}
 # setCmdTrace after


proc indexFor {what} {
  return [lsearch -exact $::glob(fListEl) $what]
}

# This routine switches buttons 2 & 3 depending on darwin or not
# It takes a string containing 1 or more 2s or 3s and returns
# the same string if not darwin and switches 2->3 and 3->2 if darwin

proc DarMou {string} {
  if {$::tcl_platform(os) != "Darwin"} {return $string}
  set 2 3
  set 3 2
  return [subst -nobackslashes -nocommands [regsub -all {2|3} $string {${\0}}]]
}

proc _  {s args} {::msgcat::mc $s {*}$args};
proc _b {s args} {::msgcat::mc $s {*}$args};

set ::bgerrRepeat 0
set ::bgerrFlush  0

proc bgerror {err} {
  global errorInfo env glob tcl_patchLevel tk_patchLevel ignor_error_flag

  # grab the errorInfo before it gets lost
  set errorInfoLoc $errorInfo
  
  # IsKnownError returns for us on known errors
  while {$::DoProtLevel > 0} {UnDoProtCmd}
  IsKnownError $err
  # Stop progress bar
  LogStatusOnly {} -1
  
  if {[info exists glob(abortcmd)] && $glob(abortcmd) > 0} {
    # note it and ignor it...
    frputs "Ignoring error during abort:"     errorInfoLoc
    LogSilent "Error: during abort, ignoring: >$errorInfoLoc<"
    return
  }
  if {[info exists ignor_error_flag] } {
    smart_dialog .bgerrorDialog[incr ::uni] .\
	[_ "no-no"]\
	[list $ignor_error_flag] \
	0 1 [_ "OK"]
    return
  }
  if {$::bgerrFlush} {
    after cancel {set ::bgerrFlush 0}
    after 1000   {set ::bgerrFlush 0}
    set ::bgerrFlush 1
    return
  }
  set butCount [expr {$::bgerrRepeat + 4}]
  set info "${errorInfoLoc}"
  set button [smart_dialog .bgerrorDialog[incr ::uni] .\
		  [_ "Fatal error in Tcl Script"] \
                  [list [_ "You have found a bug. It might be in FileRunner.\n\
                         \n"] \
		  "$err" \
		       [_ "\n\nPlease send a bugreport to the author."]] \
		  0 $butCount [list [_ "Exit"] [_ "See Stack Trace"] \
			   [_ "Prepare bugreport"] [_ "Ignor" ] [_ "Flush"]]]
  #  puts "$button"
  switch $button {
    4 {
      after 1000 {set ::bgerrFlush 0}
      incr ::bgerrFlush
      return
    }
    3 {
      after 1000 {set ::bgerrRepeat 0}
      set ::bgerrRepeat 1
      return
    }
    0 {CleanUp 1}
    2 { buildBugReport $err $info}
    1 {
      set ans [smart_dialog .bgerrorTrace[incr ::uni] . [_ "Stack Trace for Error"]\
		   [list $info ]\
		   -1 3 [list [_ "Exit"] [_ "Prepare bugreport"] [_ "Continue"]]]
      switch $ans {
	0 {CleanUp 1}
	1 {
	  buildBugReport $err $info
	}
      }
    }
  }
  return
}


# The buildStop routine builds a small window with a Stop button and a
# one line static message. It is assumed that the message ids the button so
# several may be on the display at one time. 'w' is name used as the
# parent of the stop window which will be inserted as the first entry in 'w
# A dynamic line is also provided to display status. This line is written
# (and over written) by calling "StopProgress w mess"

# The name of the frame of the stop window is returned, 
# 
# The stop command/button has 3 states 0, 1 and 2. It has a color to match
# its state: 0 normal button color, 1 flash color, 2 select fg color
#
# Stop will normally be in state 0 when the window is created (see over ride)
# When pushed,  call back to call back function with parm = 0 move to state 1
#              
# When pushed, call back to call back function with parm = 1 moves to state 2
#             
# when pushed, call back to call back function with parm = 2 stays in state 2
#
# We keep the call back script and state in the button command script
# 
# When called, this routine measures the window "w" and returns this measure
# As part of popping the stop button into the window, the rest of the window
# is hidden by sizeing it.
# When the caller wishs to remove the stop button s/he should do:
# StopButRemov w      where 'w' is the window passed in 
#                     This will resize the window and remove the 
#                     stop button pane.
#
proc buildStop {w mess callback {stopState 0}} {
  global config glob
  set wf [frame $w.f -bg $glob(gui,color_bg)]
  if {$mess != {}} {
    set mb [label $wf.l -text $mess  -bg $glob(gui,color_bg) -justify left]
    grid $mb -in $wf -row 1 -column 2 -sticky w
  }
  set sb [button $wf.b -text [_ "Stop"]]
  grid $sb -in $wf -row 1 -column 1 -sticky ew
  grid columnconfigure $wf 1 -weight 0
  grid columnconfigure $wf 2 -weight 1
  $sb config -activebackground $glob(gui,color_select_fg)
  switch $stopState {
    1  {$sb config -bg $glob(gui,color_flash)}
    2  {$sb config -bg $glob(gui,color_select_fg)}
  }
  while {[lassign [split [winfo geo $w] x+] p q f] == 0} {
    update
    if {! [winfo exists $w]} {return {}}
    if {[incr loop] > 100} {break}
  }
  frputs loop
  #after idle "frputs \"[wm geo $w]  \""
  lassign [split [wm geo $w] x+] wd h
  lassign [split [winfo geo $w] x+] d d px py
	  
  wm geo $w ${wd}x2+$px+$py
  # It is possible that this window is already gone... so...
  if {[catch "grid $wf -in $w -row 0 -column 0 -columnspan 2 -sticky ew"] == 0} {
    bind $w.f.b <Destroy> "stopDestroy $w $callback"
    $sb config -command "StopBut $sb ${wd}x$h $callback $stopState"
  }
  return ${wd}x$h+$px+$py	  
}

# the following routine is provided for those cases where we don't
# know the callback function until after the 'buildStop' call
# Because 'buildStop' calls update, for example, it needs to be
# called prior to 'pipeoExec' which returns a fid that one
# might want to put in the callback.

proc stopReSetCallBack {w callback {stopState 0}} {
  if {![winfo exists $w.f.b]} {return}
  set old [bind $w.f.b <Destroy>]
  bind $w.f.b <Destroy> [lreplace $old end end {*}$callback]
  set old [$w.f.b cget -command]
  $w.f.b config -command [lreplace $old end-1 end {*}$callback $stopState]
}

proc stopDestroy {w args} {
  # if the stop button is already gone, just return
  frputs "stopDestroy [winfo exists $w.f.b]  " w args
  if {![winfo exists $w.f.b]} {return}
  # prevent a second entry
  # destroy $w.f
  # do the stop call back with a "2", should stop the process
  eval "$args 2"
}

proc StopBut {sb geo args} {
  global config glob
  set stopState [lindex $args end]
  switch [incr stopState] {
    1  {$sb config -bg $glob(gui,color_flash)}
    2  {$sb config -bg $glob(gui,color_select_fg)}
    default {set stopState 2}
  }
  $sb config -command "StopBut $sb $geo [lreplace $args end end $stopState]"
  # must do this last as the window may not exist after 
  frputs "StopBut  "  stopState args
  eval $args
}

# this code resizes the window and removes the stop button frame
# given the toplevel window name
#
proc StopButRemove {w} {
  set r [catch {$w.f.b config -command} cmd]
  if {$r != 0} {frputs "StopButRemove  " cmd ;return}
  bind $w.f.b <Destroy> {}
  lassign [split [wm geo $w] x+] d h
  # only mess with the size if it is still just the stop button
  if {$h == 0} {
    wm geo $w [lindex $cmd 4 2]
  }
  destroy $w.f
}

# this function writes progress messages to the stop subwindow
# A text window is a bit much but it is the only one I could find
# that the width of the master set the width rather than the width
# of the text.
proc StopProgress {w mess} {
  global glob
  if {![winfo exist $w.f.p]} {
    set pb [text $w.f.p -bg $glob(gui,color_bg) -height 2]
    grid $pb -in $w.f -row 2 -column 1 -columnspan 2 -sticky wnse
  }
  $w.f.p delete 0.0 end
  $w.f.p insert 0.0 $mess
  $w.f.p see insert
}

# a debug function to print lists one entry per line
proc pls {s} {
  foreach l $s {
    puts "$l"
  }
}


proc buildBugReport {err info} {
  global glob env
  set count {}
  while {[file exists $env(HOME)/filerunner_bugreport$count.txt]} {
    if {$count == {}} {
      set count 0
    }
    incr count
  }
    
  set r [catch {open $env(HOME)/filerunner_bugreport$count.txt w} fid]
  if {$r} { 
    smart_dialog .bugrepinfo[incr ::uni] .\
	[_ "Error"] \
	[list [_ "Can't create file:\n"]\
	     "$env(HOME)/filerunner_bugreport$count.txt" \
	     [_ "\nto dump bugreport. Error:\n"] \
	     " $fid" ] \
	0 1 [_ "Exit"]
    CleanUp 1
  }
  puts $fid [_ "\nBugreport for FileRunner version %s\
                created %s.\n" $glob(displayVersion) [clock format [clock seconds]]] 
  puts $fid [_ "Please fill in/correct the rest of this and send\
               it to %s.\n\n" tom@GandK.site]
  set r [catch { exec uname -a } output]
  if {$r} { set output "" }
  puts $fid [_ "Operating System : %s" $output]
  puts $fid [_ "Tcl/Tk version   : %s / %s" $::tcl_patchLevel $::tk_patchLevel]
  puts $fid [_ "Comments         : "]
  puts $fid [_ "\nError string : %s" $err]
  puts $fid [_ "\nStack trace follows:\n--------------------\n%s" $info]
  catch {close $fid}
  if {[smart_dialog .bugrepinfo[incr ::ini] .\
	   [_ "Error"] \
	   [list [_ "Bug report file saved to:\n"] \
		$env(HOME)/filerunner_bugreport \
		[_ ".\nPlease fill in the rest of it\
                        and send it to the author."]] \
	   0 2 [list [_ "Exit"] [_ "Continue"]]] == 0 } {
    CleanUp 1
  }
}

# here is a routine to generate a large button window with a small bitmap
# The issue is that 'openbox' does not properly render such windows
# We avoid this by creating 3 button windows two of which are blank
# and can be expanded to fill the space.  All do the same thing...
#
# First a helper routine to change color of the fill
#
proc buttonWbitmapColor {path ent} {
  set whichColor [expr {$ent ? "-activebackground" : "-bg"}]
  set newColor [$path.mid cget $whichColor]
  $path.pre config -bg $newColor
  $path.post config -bg $newColor
  $path.mid config -state [expr {$ent ? "active" : "normal"}]
}

# version 1:
proc buttonWbitmap {path args} {
  # If there is a command, remove it from the list. We will use bind..
  set ops {}
  set border {}
  foreach {op val} $args {
    switch -glob $op {
      "-com*" {set command $val}
      "-bd"   -
      "-rel*" - 
      "-bord*" {lappend border  $op $val}
      default { lappend ops $op $val}
    }
  }
  frame $path {*}$border
  #puts "$path $border"
  button $path.mid {*}$ops -borderwidth 0 -default disabled -highlightthickness 0
  canvas $path.pre -borderwidth 0 -height 0 -width 0 -highlightthickness 0
  canvas $path.post -borderwidth 0 -height 0 -width 0 -highlightthickness 0
  grid $path.pre $path.mid $path.post -row 1 -sticky nsew
  grid columnconfigure $path [list $path.pre $path.post] -weight 1 -minsize 1
  grid columnconfigure $path $path.mid -weight 0
  
  bind $path.pre <ButtonRelease-1> $command
  bind $path.mid <ButtonRelease-1> $command
  bind $path.post <ButtonRelease-1> $command

  bind $path.pre <Enter>  "buttonWbitmapColor $path 1"
  bind $path.mid <Enter>  "buttonWbitmapColor $path 1"
  bind $path.post <Enter> "buttonWbitmapColor $path 1"
  
  bind $path.pre <Leave>  "buttonWbitmapColor $path 0"
  bind $path.mid <Leave>  "buttonWbitmapColor $path 0"
  bind $path.post <Leave> "buttonWbitmapColor $path 0"
  return $path
}
##########################: Map of our windows #####################
# A map of the filerunner windows, well, most of them:

# .fupper
#   .ftop  aka glob(win,top)
#      .menu_frame  (short term aka wf )
#         .file_but
#            .m     (a menu)
#         .configuration_but
#            .m     (a menu)
#         .utils_but
#            .m     (a menu)
#         .help_but
#            .m     (a menu)
#         .fasync_cmds   (short term aka w)
#            .1 --- one for each fast checkbox
#         .abort
#         .clone  (moved to utils menu)
#         .clock
#         .user
#      .status (status window/line below the above

#   .selectTex aka glob(selectWindow) this window is never displayed
#   .can       aka glob(win,can) (a canvas) (short term aka wc)
#       .fmiddle aka glob(win,middle)  (short term aka wm)
#          .1 --- one of these for each middle button
#   .scroll         Top 7 buttons in middle col (short term aka wscr)
#     .up
#     .down
#     .left
#     .right
#     .fs
#        .1
#        .2
#        .3
#   .fleft    aka glob(win,left)  (to the left of the buttons)
#      .frame_listb (passed to multilist)
#          .top
#             .c
#                .file,             .mode,       .mtime,       .owner,
#                      .size,       .slink (and scrolls)
#               .label.file, .label.mode, .label.mtime, .label.owner,
#                .label.size, .label.slink (and scrolls)
#             .ca
#          .sb
#          .v
#              .but
#              .vs
#      .top  (short term aka wft)
#         .button_back
#         .button_update
#         .stat          (label shows disk size, etc.)
#         .button_frterm (opens bottom window)
#         .button_xterm
#      .dirmenu_frame  (short term aks wf)
#         .dir_but  (tree button not in MSW version)
#            .m      (this is the tree.bit button)
#         .hotlist_but
#            .m
#         .history_but
#            .m
#         .etc_but
#            .m
#         .button_parentdir
#      .entry_dir
#          .c (returned from multilist)
#         
#   .fright   aka glob(win,right) (to the right of the buttons) (same as .fleft)
#

# .flower aka glob(win,bottom)
#    .fcmdwinleft (also .fcmdwinright)
#       .text
#       .scroll
#       .bot
#           .label (contains pwd)
#           .entry
#           .max
#           .smaller
#           .larger
#           .running

#xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
# This is called when ever the balloon help option is turned on or off or
# at start up if the configuration shows enabled.

proc preSetBalloon {} {
  global config
  if {$config(balloonhelp)} {
    setBalloon
  } elseif {[info commands ::balloon_help_config] != {}} {
    balloon_help_config enable 0
  }
}

# A routine to do the balloon config if needed. if doit is true do the
# set up, if false only do it if the code is already present.
# called from 'setBalloon', 'popupDir', 'popupListEn', 'ReConfigFont' and
# 'ReConfigColors'

proc primeBalloonHelp {doit args} {
  global glob config
  if {$doit || [info commands ::balloon_help_config] != {}} {
    package require balloonhelp
    balloon_help_config font $glob(gui,BalloonHelpFont)\
        fg $glob(gui,color_balloonHelp_fg)\
        bg $glob(gui,color_balloonHelp_bg)\
        display $::displays::monitors(monitors)\
        delay $config(hoverTime)\
        {*}$args
  }
}

proc reReadConfig {} {
  
  doDeferedMessages [ReadConfig]
  
  ForceUpdate
  Log [_ "Configuration re-read"]
  
}

proc buildConfigMenu {configmenu} {
  global glob config
  # Create CONFIGURATION menu
  if {[$configmenu index end] != "none"} {return}
  $configmenu add command \
      -label {Save Configuration} -command SaveConfig
  $configmenu add command \
      -label {Edit Configuration...} -command ConfigBrowser
  $configmenu add command -label {Reread Configuration} -command reReadConfig
  $configmenu add separator

  $configmenu add check \
      -label [_ "Expanded Error Messages"] -variable glob(debug) \
      -command "setupDebug \$glob(debug)"
  $configmenu add check \
      -label [_ "Balloon Help"] -variable config(balloonhelp) \
      -command {preSetBalloon}
  #set ::balloon_help::enable $config(balloonhelp)
  $configmenu add check \
      -label [_ "Position to directories"] -variable config(positiondirs)
  $configmenu add check \
      -label [_ "Show All Files"] -variable config(fileshow,all) \
      -command ForceUpdate
  #bind $configmenu <ButtonRelease> "$configmenu invoke active; break"
  if { !$::MSW } {
    $configmenu add check \
	-label [_ "Create Relative Links"] \
	-variable config(create_relative_links) 
  }
  $configmenu add check \
      -label [_ "Run Pwd After Cd"] -variable config(cd_pwd) 
  $configmenu add check \
      -label [_ "Run Pwd After Cd (VFS)"] -variable config(ftp,cd_pwd) 

  # Contrary to the documentation the variable seems to get updated
  # after the command.  The 1ms wait fixes things...
  $configmenu add check \
      -onvalue 1 -offvalue 0 \
      -label [_ "Focus Follows Mouse"] -variable config(focusFollowsMouse) \
      -command {after 1 "if {$config(focusFollowsMouse)== 1} \
                         {tk_focusFollowsMouse} "}
  $configmenu add check \
      -label [_ "Use FTP Proxy"] -variable config(ftp,useproxy) 
  $configmenu add separator
  $configmenu add cascade -menu $configmenu.sortOps -label "Sort Options"
  menu $configmenu.sortOps -tearoff true -tearoffcommand FixTearoff\
      -title "Sort OptionsMenu" ;# -font $glob(gui,GuiFont)
  $configmenu.sortOps add radio \
      -label [_ "ASCII sort"] -variable config(sortoption) \
      -value "-ascii" -command ForceUpdate
  $configmenu.sortOps add radio \
      -label [_ "Ignore case on sort"] -variable config(sortoption) \
      -value "-nocase" -command ForceUpdate
  $configmenu.sortOps add radio \
      -label [_ "Dictionary sort"] -variable config(sortoption) \
      -value "-dictionary" -command ForceUpdate

  $configmenu.sortOps add separator
  $configmenu.sortOps add radio \
      -label [_ "Sort Dirs First"] -variable config(fileshow,dirs) \
      -value dirsfirst -command ForceUpdate
  $configmenu.sortOps add radio \
      -label [_ "Sort Dirs Last"] -variable config(fileshow,dirs) \
      -value dirslast -command ForceUpdate
  $configmenu.sortOps add radio \
      -label [_ "Dirs Mixed"] -variable config(fileshow,dirs) \
      -value mixed -command ForceUpdate
  $configmenu.sortOps add separator
  $configmenu.sortOps add radio \
      -label [_ "Sort On Name"] -variable config(fileshow,sort) \
      -value nameonly -command ForceUpdate
  $configmenu.sortOps add radio \
      -label [_ "Sort On Modify Time"] -variable config(fileshow,sort) \
      -value mtime -command ForceUpdate
  $configmenu.sortOps add radio \
      -label [_ "Sort On Access Time"] -variable config(fileshow,sort) \
      -value atime -command ForceUpdate
  $configmenu.sortOps add radio \
      -label [_ "Sort On Create Time"] -variable config(fileshow,sort) \
      -value ctime -command ForceUpdate
  $configmenu.sortOps add radio \
      -label [_ "Sort On Reverse Modify Time"] -variable config(fileshow,sort) \
      -value rmtime -command ForceUpdate
  $configmenu.sortOps add radio \
      -label [_ "Sort On Reverse Access Time"] -variable config(fileshow,sort) \
      -value ratime -command ForceUpdate
  $configmenu.sortOps add radio \
      -label [_ "Sort On Reverse Access Time"] -variable config(fileshow,sort) \
      -value rctime -command ForceUpdate
  $configmenu.sortOps add radio \
      -label [_ "Sort On Size"] -variable config(fileshow,sort) \
      -value size -command ForceUpdate
  $configmenu.sortOps add radio \
      -label [_ "Sort On Extension"] -variable config(fileshow,sort)\
      -value extension -command ForceUpdate
  $configmenu add separator
  $configmenu add cascade -menu $configmenu.color -label "Color Edit Menu"
  menu $configmenu.color -tearoff true -tearoffcommand FixTearoff \
      -title "Color Edit Menu" ;# -font $glob(gui,GuiFont)
  $configmenu add separator
  $configmenu.color add command \
      -label {Edit Entry BG Color...} -command "EditColor color_bg"
  $configmenu.color add command   \
      -label {Edit Entry FG Color...} -command "EditColor color_fg"
  $configmenu.color add command \
      -label {Edit Selection BG Color...} -command "EditColor color_select_bg"
  $configmenu.color add command \
      -label {Edit Selection FG Color...} -command "EditColor color_select_fg"
  $configmenu.color add command \
      -label {Edit Highlight BG Color...} -command "EditColor color_highlight_bg"
  $configmenu.color add command   \
      -label {Edit Highlight FG Color...} -command "EditColor color_highlight_fg"
  $configmenu.color add command \
      -label {Edit Lisbox handle Color...} -command "EditColor color_handle"
  $configmenu.color add command \
      -label {Edit Shell Cmd Color...} -command "EditColor color_cmd"
  $configmenu.color add command \
      -label {Edit Color Scheme...} -command "EditColor color_scheme"
  $configmenu.color add command \
      -label {Edit Cursor Color...} -command "EditColor color_cursor"
  $configmenu.color add command \
      -label {Edit Flash Color...} -command "EditColor color_flash"
  $configmenu.color add command \
      -label {Edit Balloon Help FG Color...} \
      -command "EditColor color_balloonHelp_fg"
  $configmenu.color add command \
      -label {Edit Balloon Help BG Color...} \
      -command "EditColor color_balloonHelp_bg"
  $configmenu add command \
      -label {Edit Fonts} -command "DoEditFont"
  $configmenu add separator
  $configmenu add command \
      -label {Set Start Dir Left} -command "DoProtCmd \"SetStartDir left\""
  $configmenu add command \
      -label {Set Start Dir Right} -command "DoProtCmd \"SetStartDir right\""
  $configmenu add radio \
      -label [_ "Set Column Scroll Bar Off"] -variable config(columnScroll) \
      -value 0 -command "BuildListBoxes"
  $configmenu add radio \
      -label [_ "Set Column Scroll Bar Top"] -variable config(columnScroll) \
      -value 1 -command "BuildListBoxes"
  $configmenu add radio \
      -label [_ "Set Column Scroll Bar Bottom"] -variable config(columnScroll) \
      -value 3 -command "BuildListBoxes"
  $configmenu add command \
      -label {Set Window Pos/Size} -command "SetWinPos"
  # This line is here just to get the user available button commands into the
  # glob(buttoncmds) list
  buildUtilsMenu $glob(win,top).menu_frame
}
proc buildFileMenu {wf} {
  # Create FILE menu
  $wf.file_but.m delete 0 end
  $wf.file_but.m add command \
      -label About... \
      -command About
  $wf.file_but.m add command \
      -label [_ "View Log..."] \
      -command { ViewLog }
  $wf.file_but.m add command\
      -label [_ "View Error Window"]\
      -command {PopError {}}
  
  $wf.file_but.m add command \
      -label Quit -command { CleanUp 0 }
}
proc buildUtilsMenu {wf} {
  # Create Utilities menu
  # A "+" in the following list means that the command and its label will be
  # added to the list of command available to user configured menues.
  # We want the first item in the utilites menu on MSW to be the start menu
  # and, at the same time, the 3ed item to be the elevate/root command. So...
  set opClean {}
  $wf.utils_but.m delete 0 end
  set startMenuHook [list {-label {Clean (destroy View windows)} -command {Clean}}\
			 {-label {Prob monitor(s) workspace}\
			      -command {Try {::displays::init} -a}}]
  if {$::MSW} {
    # set this when we have the code...
    set startMenuHook {}
    # set startMenuHook [list {-label  {Start Menu}   -command {winStartMenu}}]
    set opClean [list {-label {Clean (destroy View windows)} -command {Clean}}]
  }
  ButtonAdd $wf.utils_but.m {} \
      [concat \
	   [list {*}$startMenuHook\
		{+-label {Swap Windows} -command {CmdSwapWindows}}\
		{+-label {[lindex $::config(cmd,ucmd) 0]}\
		     -command {eval [lindex $::config(cmd,ucmd) 1]}}\
		{*}$opClean\
		{+-label {What Is?...}                  -command {CmdWhatIs}}\
		{+-label {Select On Contents...}        -command {CmdCSelect}}\
		{+-label {Run Command}                  -command {CmdRunCmd}}\
		{+-label {Check Size Of Selected...}    -command {CmdCheckSize}}\
		{-label  {Clone}                        -command {NP Clone}}\
		{-label  {Show/edit Passwords}          -command {editPasswords}}\
		{-label  {Show Console}                 -command {NP Try showcon -a}}\
	    ]\
	   $::UtilsMenu::ents
       ]
}

proc showcon {} {
  realWaitForIdle
  after 0 {
    if {![winfo exists .tkcon]} {
      Log "loading tkconrc"
      set ::tkconrcVer [package require tkconrc]
      Log "tkconrc $::tkconrcVer loaded"
    }
    tkcon show
    realWaitForIdle
    # here is a little jig we dance to get the
    # window on top but not fixed there
    toTop .tkcon
  }
}
# A little ditty to bring a window to the top

proc toTop {w} {
  set top [winfo toplevel $w]
  wm withdraw $top
  wm attribute $top -topmost 1
  wm deiconify $top
  wm attribute $top -topmost 0
}


  #bind $wf.configuration_but <1> "::tk_popup $wf.configuration_but.m  %X %Y;break"
proc ShowWindow {} {
  global glob tk_version argv argv0 config env win fast_checkboxes tcl_platform
  startProc "Start Main Window build"
  wm positionfrom . user
  wm sizefrom . ""
  # set glob(orgTitle) ([wm title .])
  wm title . "FileRunner  v$glob(displayVersion) $glob(orgTitle)"
  wm geometry . [getGeo $config(geometry,main) .]
  wm protocol . WM_DELETE_WINDOW { CleanUp 0 }
  wm iconname . "FileRunner v$glob(displayVersion)"
  wm command . [concat $argv0 $argv]
  wm group . .

  frame .fupper -bd 0
  frame .flower -bd 0
  .flower config -background blue
  #  puts "$glob(win,top)"
  frame $glob(win,top) -borderwidth 2 -relief raised
  # TOP LEVEL MENU BUTTONS
  # Just for those who want to know (mainly me) we don't use a menubar because:
  # a) we want some simple buttons here, e.g. "stop"
  # b) we want checkboxes here (fast check boxes)
  # c) we are also putting various bits of info here (name@machine, current time)
  #
  # To get the cascade to work in menus we want it, we change the <Motion> binding
  # to use to conditionally alter (actually define) an ::tk:: internal.

  # In an attempt to speed up the start up code (or what is so perceived) we defer
  # building the menu contents until after we have the main window up (or until
  # called for some). We do the same thing for the balloonhelp...
  set wf [frame $glob(win,top).menu_frame]
  # File menu
  menubutton $wf.file_but\
      -menu $wf.file_but.m \
      -takefocus 0 \
      -text [_ "File"] 
  menu $wf.file_but.m -tearoff false\
      -postcommand [list buildFileMenu $wf]
      # -font $glob(gui,GuiFont)
  # Configuration menu
  menubutton $wf.configuration_but -takefocus 0 \
      -menu $wf.configuration_but.m \
      -text [_ "Configuration"]
  set configmenu $wf.configuration_but.m
  menu $configmenu -tearoff false\
      -postcommand [list buildConfigMenu $configmenu]
      # -font $glob(gui,GuiFont)
  #======================= Here is the Motion work around ====================
  bind $wf.configuration_but <Motion> {+
    if {$::tk::Priv(postedMb) == "%W"} {
      set ::tk::Priv(menuActivated) 1
    }
  }
  #======================= End of  the Motion work around ====================
  # Utilities menu
  menubutton $wf.utils_but -takefocus 0\
      -menu $wf.utils_but.m\
      -text [_ "Utilities"]
  menu $wf.utils_but.m -tearoff true \
      -tearoffcommand FixTearoff \
      -postcommand [list buildUtilsMenu $wf]
  # -font $glob(gui,GuiFont)
  # Help menu
  menubutton $wf.help_but\
      -takefocus 0\
      -menu $wf.help_but.m\
      -text [_ "Help"] 
  menu $wf.help_but.m \
      -tearoff false\
      -postcommand CreateHelpMenu
     # -font $glob(gui,GuiFont)

  # Raised buttons
  frame $wf.fasync_cmds -bd 0
  # Stop button
  button $wf.fasync_cmds.abort -takefocus 0 \
      -borderwidth 1 \
      -text [_ "Stop"] \
      -command {set ::glob(abortcmd) 1}
  label $wf.async -text [_ "Async 0"]
  # Clone button
  #    -state disabled \
  # button $wf.clone\
  #     -takefocus 0\
  #     -borderwidth 1\
  #     -text [_ "Clone"]\
  #     -command Clone
  
  # Lay out the menus on the top of the window
  label $wf.clock -text [Time]
  # pack $wf.clock -side right
  # Put in who we are and what machine...
  if {!$::MSW}  {
    set user [exec whoami]
    set host [expr {[info exists env(HOST)] ? $env(HOST) : \
			[info exist env(HOSTNAME)] ? $env(HOSTNAME) : "??"}]
    set host [expr {$::IsWSL ? "$host:WSL:$::WSLname" : $host}]
  } else {
    set user $env(USERNAME)
    set host [expr {[info exists env(COMPUTERNAME)] ? $env(COMPUTERNAME) : "??"}]
  }
  label $wf.user -text "$user@$host  "
  # Reserve our status line just below the menu bar
  #     -textvariable ::glob(statusline)\
  #    -state readonly
  set stat [text $glob(win,top).status\
		-height 1\
		-relief groove\
		-bd 2\
		-exportselection 0]
  set glob(statusline) {}
  # We use an entry window so we can put up a status bar
  # grid the menu line at the top...
  set fixedLeft [list \
		     $wf.file_but \
		     $wf.configuration_but \
		     $wf.utils_but \
		     $wf.async\
		     $wf.fasync_cmds ]
  set varRight [list \
		    $wf.user \
		    $wf.clock \
		    $wf.help_but]
  startProc "Start griding main window"
  foreach win $fixedLeft {
    grid $win -row 0 -column [incr col] -sticky w
  }
  foreach win $varRight {
    grid $win -row 0 -column [incr col] -sticky e
  }
  #
  grid columnconfigure $wf $fixedLeft -weight 0
  grid columnconfigure $wf $col -weight 0; # help menu
  grid columnconfigure $wf [incr col -1] -weight 1 ; # clock
  grid columnconfigure $wf [incr col -1] -weight 100 ; # user
  # Now the status line
  grid $wf   -sticky ew -row 2
  grid $stat -sticky ew -row 4
  grid columnconfigure $glob(win,top) 0 -weight 1
  grid $wf.fasync_cmds.abort -row 0 -column 0
  
  # This completes the .fupper window, two lines
  
  # Build the left and right panels

  BuildFileListPanel left
  BuildFileListPanel right
  
  startProc "After list Panel build"

  set glob(selectFileList) {}
  # This window is NEVER displayed.  It is only used to pass the selection
  # to the window system.
  set glob(selectWindow) [listbox .fupper.selectTex \
			      -listvariable glob(selectFileList)]\

  # build widget .fm
  # The "width" below is overridden later, but here now because
  # we want this window to be near the right size when it shows
  # during start up. Orange is just a debug feature so we know
  # what window we are looking at.
  set wc [canvas .fupper.can -background orange -width 0]
  set glob(win,can) $wc
  set wm [frame $glob(win,middle) ] ; # -background gold
  #

  set glob(cmds,cur) 0
 
  set wscr [frame .fupper.scroll -borderwidth 0 -relief raised]
  buttonWbitmap $wscr.up \
      -relief raised \
      -borderwidth 1\
      -command "whatDoesTheFoxSay $wc -1" \
      {*}[getImage -bitmap pgup  @$glob(lib_fr)/bitmaps/pgup.bit]
  
  
  buttonWbitmap $wscr.down \
      -relief raised \
      -borderwidth 1\
      {*}[getImage -bitmap pgdown @$glob(lib_fr)/bitmaps/pgdown.bit]\
      -command "whatDoesTheFoxSay $wc 1"
  
  
  # the <- -> middle buttons...
  set c [lindex $glob(cmds,list) 0]
  set n 1
  frame $wm.$n -bd 0 ; # -background red
  frame $wscr.fs -bd 0
  incr n
  set c [lindex $glob(cmds,list) 1]
  foreach inst {left right} {
    buttonWbitmap $wscr.$inst \
	-relief raised \
	-borderwidth 1\
	{*}[getImage -bitmap $inst @$glob(lib_fr)/bitmaps/$inst.bit] \
	-command "DoProtCmd CmdTo$inst"
    
    button $wscr.fs.$inst  \
	-command "DoProtCmd ColTo$inst" \
	{*}[getImage -bitmap small-$inst\
		@$glob(lib_fr)/bitmaps/small-$inst.bit]
    
  }
  button $wscr.fs.mid \
      -command "DoProtCmd ToggleCollock"\
      {*}[getImage -bitmap lock\
	      @$glob(lib_fr)/bitmaps/lock.bit]
  
  #$wscr config -height [winfo reqheight $wscr.up]
  grid  $wscr.up $wscr.down -row 1 -sticky nsew
  grid  $wscr.left $wscr.right -row 2 -sticky nsew
  grid  $wscr.fs.left $wscr.fs.mid $wscr.fs.right -sticky nsew
  grid  $wscr.fs -row 3 -columnspan 2 -sticky ew
  grid columnconfigure $wscr all -weight 1
  grid columnconfigure $wscr.fs all -weight 1

  grid columnconfigure $wm all -weight 1
  
  $wc create window 0 0 -window $wm -anchor nw
  
  #grid columnconfigure $glob(win,bottom) all -weight 0
  grid columnconfigure $glob(win,bottom) all -weight 0
  grid columnconfigure $glob(win,bottom) 0 -weight 1
  grid .fupper -sticky news -row 2
  grid propagate .fupper 0

  startProc "Start CmdWindow build"

  BuildCmdWindow left
  BuildCmdWindow right
  startProc "After CmdWindow build"
  # Grid the top window "."
  grid rowconfigure . 2 -weight 1
  grid columnconfigure . all -weight 1
  # grid $glob(win,bottom) -sticky news -row 6
  # By using the grid routine we can force the middle buttons to stay
  # after all else is gone (well that is better than loosing them early
  # when the window width is decreased.  We also keep the two list widths
  # balanced.
  grid $glob(win,top) -column 0 -columnspan 3 -row 0 -sticky ew
  grid $glob(win,left) -column 0 -rowspan 2 -row 1 -sticky nsew
  grid $wscr -column 1 -columnspan 1 -row 1 -sticky news
  grid $wc -column 1 -row 2 -sticky news
  grid $glob(win,right) -column 2 -rowspan 2 -row 1 -sticky nsew
  grid rowconfigure .fupper all -weight 0
  grid rowconfigure .fupper  $wc -weight 1
  grid columnconfigure .fupper all -weight 1
  grid columnconfigure .fupper $wc -weight 0
  

  # grid remove $glob(win,bottom)
  set glob(TraceColToEnabled) 0
  set glob(panelsLocked) \
      [expr {$config(ListBoxColumns,left) != $config(ListBoxColumns,right)}]
  ToggleCollock
  # trace add variable config(ListBoxColumns,left) write \
  #     "after idle {TraceColTo left right}"
  # trace add variable config(ListBoxColumns,right) write \
  #     "after idle {TraceColTo right left}"
}

####################: Begin ## postConfigShow ############################
# This bit gets called after reading a new config file. It fixes/sets up
# the stuff that depends on config options.
# It needs to be able to be re-executed each time we read config

# buttonHelp is an array indexed by button window name. Each entry is either
# nil (i.e. {}) or the name and index into a list that contains the message

proc postConfigShow {} {
  global glob config win fast_checkboxes buttonHelp
  #  proc what {in } { puts "$in"}
  Log "glob(init_done) $glob(init_done)"
  if {!$glob(init_done) || 1} {
    # don't do this except on initial load
    lassign [split [getGeo $config(geometry,main) .] x+] W H X Y
    # check if we are to do other
    set mon [::displays::get {*}[winfo pointerxy .]]
    # frputs mon
    Log "mon $mon"
    switch -glob $config(geometry,mainops) {
      ra* {wm geo . ${W}x${H} }
      re* {
	set mon2 [::displays::get $X $Y]
	if {$mon2 != $mon} {
	  set X [expr {$X - [lindex $mon2 0] + [lindex $mon 0]}]
	  set Y [expr {$Y - [lindex $mon2 2] + [lindex $mon 2]}]
	}
	wm  geo . ${W}x${H}+${X}+$Y	       
      }
      c*  {centerWin . $mon}
      a* -
      default {wm geo . ${W}x${H}+${X}+$Y }
    }
    wm att . -al 1.0
  }
  set n 0
  set w  $glob(win,top).menu_frame.fasync_cmds
  # set savcon 0
  set newConfig {}
  array unset buttonHelp 
  # A paranoid check. If the length is not exactly 4, remove it.
  foreach ent $config(fast_checkboxes) {
    if {[llength $ent] != 4} {continue}
    lappend newConfig $ent
  }
  set config(fast_checkboxes) $newConfig
  set newConfig {}
  # Make sure all fast_checkbox buttons appear in the list.
  # Add any missing ones at the end and disabled.
  foreach fcb $fast_checkboxes {
    set nam [lindex $fcb 0]
    if {[lsearch -exact -index 0 $config(fast_checkboxes) $nam] == -1} {
      lappend config(fast_checkboxes) [list $nam $nam d \
					   [subst [lindex $fcb 3]]]
      # incr savcon
      # frputs savcon
    }
  }
  #puts "added $savcon fast check boxes"
  set deletedFCB "The following \"check box\" entries have \
                      \nbeen removed from config(fast_checkboxes):"
  foreach k $config(fast_checkboxes) {
    destroy $w.$n
    if {[set kn [lsearch -index 0 -exact \
		     $fast_checkboxes [lindex $k 0]]] != -1 } {
      #puts "$k [lindex $k 2]"
      if { [lindex $k 2] != "d" } {
	set kk [lindex $fast_checkboxes $kn]
	lassign [lindex $kk 2] var onVal offVal initVal
	set onVal [expr {$onVal == {} ? 1 : $onVal}]
	set offVal [expr {$offVal == {} ? 0 : $offVal}]
	#puts "$w.$n checkbox [lindex $k 1] $var $onVal $offVal"
	checkbutton $w.$n -takefocus 0 -variable $var \
 	    -text "[lindex $k 1]" \
	    -onvalue $onVal \
	    -offvalue $offVal \
            -command "[lindex $kk 1]"
        #   -selectcolor #fffffe
        set buttonHelp($w.$n) [list fast_checkboxes $kn 3]
	# balloonhelp_for $w.$n  [lindex $kk 3]
	grid $w.$n -row 0 -column [incr col]
	# if an initial value is provided, set up oppsit and invoke
	if {$initVal != {}} {
	  set [set var] [expr {$initVal == $offVal ? $onVal : $offVal}]
	  $w.$n invoke
	}
 	incr n
      }
      if {[lsearch -index 0 -exact $newConfig [lindex $k 0]] == -1} {
	lappend newConfig $k
      }
    } else {
      # this config entry was not found in our list, we
      # drop it with a PopWarn later...
      # but it does mean we need to save the new one
      # puts "marked $k for delete"
      set someDeleted 1
      append deletedFCB "\n[lindex $k 0]"
      # set savcon 1
      # frputs savcon
    }
  }
  set config(fast_checkboxes) $newConfig
  startProc "After checkbox set up "

  ###############################: Middle Button Management ###########################

  # Middle button management. There are 3 sources of middle
  # buttons:
  # 1) glob(cmds,list)       (The built in commands)
  # 2) config(usercommands)  (Built as defined in the "User's Guide")
  # 3) config(userButton,*)  (Configured in the configuration script)
  #
  # All buttons appear (or will appear) in the config(middle_button_list)
  # which defines the order used in the middle button column.
  # If a button is not in config(middle_button_list) it is added at the
  # end and is enabled (so the user is aware of it)
  # On type 3:
  # The button name will be what ever is used for "*". The label text
  # will be either the "label <text>" or the name with the first char.
  # in caps. The button name is passed to the command so it can access
  # the config info.
  
  # Now add the new set    
  set foo {}
  set butMess {}
  set midMess {}
  # the following code makes sure that the config button list is complete
  # missing entries are supplied as enabled to draw attention to them.
  # First lets reformat the middle button list.
  # This takes care of old formats and give a nice new consistant one.
  # The new list has three (or more) entries for each button:
  # 1. The reference name
  # 2. The display   name
  # 3. A bool, true to display (1, true, yes, on) or (0, false, no, off)
  # 4 & 5 possible button colors (optional)
  
  # As part of this, we verify that the button exist in:
  # glob(cmds,list) or config(userButton,*) or config(usercommands)
  # and we take the first and ignor the rest.
  
  # This cleans any entries in the config button list that we don't know
  # about.
  set displayNames {}
  set n 1
  set wc $glob(win,can)
  set wm $glob(win,middle)
  # We use a much too long a list here to insure we don't miss any.
  for {set nn $n} \
      {$nn <= [expr {2 * [llength $config(middle_button_list)]}]} \
      {incr nn} {
	destroy $wm.$nn
      }
  startProc "Begin build middle buttons "
  # frputs config(middle_button_list)'

  set userButtons {}
  foreach {name val} [array get config "userButton,*"] {
    lappend userButtons [string range $name 11 end]
  }
  set lnMidList              [llength $config(middle_button_list)]
  set lnMidPlusCmdsList      [expr {[llength $glob(cmds,list)] + $lnMidList}]
  set lnMidPlusCmdsPlusUser  [expr {[llength $userButtons] + $lnMidPlusCmdsList}]
  set index -1
  set newMid {}
  foreach ent [concat $config(middle_button_list)\
		   $glob(cmds,list)\
		   $userButtons \
		   $config(usercommands)] {

    set extra [lassign $ent name displayName enable]
    
    if {[incr index] < $lnMidList} {
      # This is the middle_button_list
      
      if {[lindex $ent end] == "d"} {
	set enable "off"
	set ent [lreplace $ent end end]
      }
      set len [llength $ent]
      switch -exact $len {
	1 -
	2 {
	  if {$len == 2} {
	    set ent [list $ent]
	    set name $ent
	  }
	  set ent [list $ent [_ $ent]]
	}
	3 -
	4 -
	5 {}
	default {
	  lappend midMess "Bad format ($ent) in config(middle_button_list). Ignoring entry."
	  continue
	}
      }
    } else {
      lassign {} displayName enable extra
      set wh [expr {$index < $lnMidPlusCmdsList ? "built in commands" : \
			$index < $lnMidPlusCmdsPlusUser ? "user button" : \
			"user cmd file"}]
      if {[lsearch -index 0 -exact $newMid $name] != -1} {continue}

      lappend foo [list $name $wh]
      frputs name
    }

    # prune if already in our new list...
    # This will only prune dups from the middle_button_list
    # Other dups are caught above.
    if {[lsearch -index 0 -exact $newMid $name] != -1} {continue}

    # At this point if the entry came from the middle_button_list, we have
    # captured the name, display Name (or {}) enable (on or {} or off)
    # and any extra stuff at the end (if none {})

    # Now we need to get details from one of three lists we are using to
    # source buttons.

    # since we look for the character we don't use the char number in
    # the structure any more (that would be 'keyu' below).
    lassign {} key balloon
    # ok, lets see if it is a legal entry...
    if {($index >= $lnMidList && $index < $lnMidPlusCmdsList) ||\
            [set idx [lsearch -index 0 -exact \
                          $glob(cmds,list) $name]] != -1} {
      set ent [lindex $glob(cmds,list) $idx]
      lassign $ent name command key keyu
      set balloon [list glob(cmds,list) $idx 4]
      # Its one of our commands
    } elseif {[info exists config(userButton,$name)]} {
      # Its a user button...
      # A user button, get the label
      foreach {key value} $config(userButton,$name) {
	if {[string match "l*" $key]} {
	  set displayName $value
	  break
	}
      }
      set command "DoUsrButton $name"
    } elseif {[set idx [lsearch -index 0  -exact \
                            $config(usercommands) $name]] != -1} {
      set k [lindex $config(usercommands) $idx]
      # Its a user command
      set command [list DoUsrCmd [lindex $k 1]]
      set balloon [list config(usercommands) $idx 2]
    } else {
      # This is not one of the known, quietly drop it
      continue
    }
    if {$displayName == {}} {
      set displayName $name
    }
    # get the colors
    # We allow entries from the middle button list to override the
    # middle_button_colors list (which we will eliminate some day)
    if {$extra == {}} {
      foreach color [lsearch -exact -inline -index 0 -all \
			 $config(middle_button_colors) $name] {
	lappend extra [lindex $color 1]
      }
    }
    # Take care of the ordering problem in all cases.
    if {[string index $extra 0] == "-"} {
      set extra  [lreverse $extra]
    }
    if {$enable == {}} {
      set enable "on"
    }
    lappend newMid [list $name $displayName $enable {*}$extra]
    if {!$enable} {continue}
    set dn 0
    while {$displayName in $displayNames} {set displayName $displayName[incr dn]}
    lappend displayNames $displayName
    lappend buttonInfo [list $displayName $command $key $keyu]

  # So lets build the button....
    button $wm.$n -text $displayName -command \
	"set glob(mbutton) 1; DoProtCmd \"$command\""
    set buttonHelp($wm.$n) $balloon
    # balloonhelp_for $wm.$n [expr {$balloon == {} ? \
    #     				  "No help for $displayName" : $balloon}]
    # key  is the magic key if not nil we will dispatch this command on this key
    if {$key != ""} {
      # The char # was based on the original name..
      # See if we have such a char now
      # find caps first..
      set keyU [string toupper $key]
      set uc [string first $keyU $displayName]
      if {$uc == -1} {
	set uc [string first $key $displayName]
      }
      # Only underscore if we have such a char., however,
      # we still will dispatch the command on this char.
      if {$uc != -1} {
	$wm.$n configure -underline $uc
      }
    }
    # Windows does not activate a button when the mouse enters
    # We effort to fix that WRT color.
    bind $wm.$n <Enter> +[list doButColor $wm.$n -activebackground]
    bind $wm.$n <Leave> +[list doButColor $wm.$n -highlightbackground]
    
    bind $wm.$n <ButtonRelease-3> "set glob(mbutton) 2
                         set glob(async) {-a}
                         DoProtCmd \"$command\""
    bind $wm.$n <ButtonRelease-2> "set glob(mbutton) 3
                         DoProtCmd \"$command\""
    grid $wm.$n -row $n -sticky ew
    # Now the color if needed....
    # We need to do this after each color change as well.  Make a list...
    if {$extra != {}} {
      lappend glob(savedButtonColors) [list $wm.$n {*}$extra]
    }
    
    incr n
  }
  
  
  # Use lnorm to prevent white space from messing with the compare.
  if {[lnorm $config(middle_button_list)] != $newMid} {
    set config(middle_button_list) $newMid
  }
  # frputs foo
  if {$foo != {}} {
    set butMess  "Added these buttons <- from:\n\n"
    foreach this $foo {
      lassign $this but where
      append butMess "$but" " <- " "$where\n"
    }
    append butMess "\nto the middle button list"
    set foo {}
  }
  # if {$savcon != 0} {
  #   #puts "saving new config"
  #   SaveConfig
  #   lappend ::startTimes [list [clock milliseconds] "After save Config "]
  # }
  startProc "End build middle buttons "
  # update idletasks
  set i 1
  while {$i < $n} {
    bind $wm.$i <MouseWheel> "whatDoesTheFoxSay $wc -%D;break"
    bind $wm.$i $config(mwheel,neg) "whatDoesTheFoxSay $wc -1 ;break"
    bind $wm.$i $config(mwheel,pos) "whatDoesTheFoxSay $wc  1 ;break"
    incr i
  }
  set glob(cmds,number) $n
  # buttoncmds are possible bindings for the three mouse presses on dir
  # listings.
  set glob(middlebuttoncmds) {}
  foreach c $glob(cmds,list) {
    set name [_ [lindex $c 0]]
    switch -regexp $name {
      ^[[:alnum:]].* {
	lappend glob(middlebuttoncmds) [list [_ [lindex $c 0]] \
					 [lindex $c 1] [lindex $c 4]]
      }
    }
  }
  setMidButColor
  # we need this wait to get good info on heigth and width
  startProc "After wait for button info "

  if {![info exists someDeleted] || !$someDeleted} {
    set deletedFCB {}
  }
  # set glob(TraceColToEnabled) 1
  # if {$config(ListBoxColumns,left) !=\
  # 	  $config(ListBoxColumns,right)} {
  #   TraceColTo left right
  # }
  return [list $deletedFCB [list $butMess]]
}
# We put the following here to be called later when (we hope)
# the windows are well enough defined that winfo will return
# correct information. With out a delay, the middle column is
# too narrow and too long.
proc finishButtonScroll {} {
  global glob
  set wc $glob(win,can)
  set wm $glob(win,middle)
  set rq [winfo reqheight $wm]
  $wc config -scrollregion [list 0 0 0 $rq] \
      -width [winfo reqwidth $wm]\
      -yscrollincrement [winfo reqheight $wm.1]
}
#####################: End of postConfigShow ####################

proc doButColor {w which} {
  $w config -bg [$w cget $which]
}

proc setMidButColor {} {
  global glob config
  foreach info $glob(savedButtonColors) {
    foreach color [lassign $info w] {
      if {[catch {
	if { [string index $color 0] == "-" } {
	  $w configure -activebackground [set color [string range $color 1 end]]
	} else {
	  lassign [winfo rgb . $color] r g b
	  set fg [expr {$r+1.5*$g+0.5*$b > 100000 ? "black" : "white"}]
	  $w configure -background $color\
	      -activebackground [LighterColor2 $color]\
	      -highlightbackground $color\
	      -fg $fg
	}
      } er] != 0} {
	set butNo [string range [file ext $w] 1 end]
	PopError "Error processing button color for middle button $butNo:\
         	  \n$er\
		  \nPlease fix this in the configuration."
      }
    }
  }
}

# This function decides if it it cool to pass a scroll request to the
# window this function is designed to catch a problem of scrolling down
# such that the top is below zero (a canvas scroll issue)
proc whatDoesTheFoxSay {w scr {scrinc 1}} {
  set scr [regsub -- {--} $scr {}]
  set scrin [expr {$scr < 0 ? -$scrinc : $scrinc}]
  #Log "the fox says $scr $scrin [$w yview]"
  if {$scr < 0 && [lindex [$w yview] 0] == "0.0"} {
    $w yview moveto 0.0
  } else {
    $w yview scroll $scrin units
  }
}

proc ToggleCollock {} {
  global glob config
  set w .fupper.scroll.fs
  # only do something if eq/neq button is psudo enabled
  if {[$w.mid cget -wraplength]} {return}
  if {$glob(panelsLocked)} {
    set glob(panelsLocked) 0
    foreach inst {right left} {
      if {[$w.$inst cget -wraplength]} {
	$w.$inst conf -wraplength 0 -image \
	    [string range [$w.$inst cget -image] 0 end-1]
      }
      # if {[$w.left cget -wraplength]} {
      # 	$w.left conf -wraplength 0 -image \
      # 	    [string range [$w.left cget -image] 0 end-1]
      # }
    }
    $w.mid conf {*}[getImage -bitmap unlock \
		      @$glob(lib_fr)/bitmaps/unlock.bit]
  } else {
#    if {$config(ListBoxColumns,left) != $config(ListBoxColumns,right) } {}
    set glob(panelsLocked) 1
    foreach inst {right left} {
      $w.$inst conf -wraplength 1\
	  {*}[getImage bitmap small-${inst}c\
		  -file $glob(lib_fr)/bitmaps/small-$inst.bit\
		  -foreground $config(gui,color_highlight_fg)]
      # $w.left conf -wraplength 1\
      # 	  {*}[getImage bitmap small-leftc\
      # 		  -file $glob(lib_fr)/bitmaps/small-left.bit\
      # 		  -foreground $config(gui,color_highlight_fg)]
    }	
    $w.mid conf -wraplength 0\
	{*}[getImage -bitmap lock\
		@$glob(lib_fr)/bitmaps/lock.bit]
  }
}

proc ColToleft {} {
  ColTo right left
}

proc ColToright {} {
  ColTo left right
}
proc ColTo { from to args} {
  #  puts "ColTo $from $to $args"
  # setupDebug 1
  #frputs #1 #2 #3
  global glob config
  if {$config(ListBoxColumns,left) != $config(ListBoxColumns,right)} {
    set config(ListBoxColumns,$to) $config(ListBoxColumns,$from)
    #   $glob(listbox,$to)
    set w .fupper.scroll.fs.mid
    if {[$w cget -wraplength]} {
      $w conf -wraplength 0\
	  -image [string range [$w cget -image] 0 end-1]
    }
    buildListBox $to
    # wait for the dust to settle...
    update idletasks
    ReConfigColors foo
    ReConfigFont
  }
}

# This gets called when the list  box colums are changed.
proc TraceColTo { from to args} {
  global glob config
  if {!$glob(TraceColToEnabled)} {return}
  set glob(TraceColToEnabled) 0
  if {$glob(panelsLocked)} {
    ColTo $from $to
  } else {
    set nstate [expr {$config(ListBoxColumns,left) !=\
			  $config(ListBoxColumns,right)}]
    # we keep the logical state in wraplength as disable messes
    # with the image
    # 1 is disabled and we display the colored image which must be not-eq
    set image [lindex [getImage bitmap unlockc\
			   -file $glob(lib_fr)/bitmaps/unlock.bit\
			   -foreground $config(gui,color_highlight_fg)]\
		   1]
    if {!$nstate} {
      # color images have a "c" added to the end of the name
      set image [string range $image 0 end-1]
    }
    .fupper.scroll.fs.mid conf -wraplength $nstate \
	-image $image
  }
  set glob(TraceColToEnabled) 1
}

# ######################: Color and Font stuff ############
proc EditColor { color } {
  global config glob
  set c $glob(gui,$color)
  if {$c == ""} {set c [set glob(gui,$color) grey85]}
  ColorEditor $color "global glob;\
      set glob(gui,$color) %%;ReConfigColors" $c $config(gray)
}

proc DoEditFont {} {
  set newGui [EditFont ListBoxFont]
  if {$newGui != 0} {
    SaveConfig
  }
  # If this is needed, we also need to update the dir listings
  # if {$newGui > 1} {
  #   ReadConfig
  # }
}

proc ReConfigFont {} {
  global glob config
  if {$glob(gui,GuiFont) == "" } {
    set $glob(gui,GuiFont) $config(gui,GuiFont)
  } 
  catch {tk_setFont $glob(gui,GuiFont)} out
    # set glob(gui,GuiFont) $config(gui,GuiFont)

  #  if {$config(gui,ListBoxFont) != $glob(gui,ListBoxFont)} {}
  foreach k $glob(winlist,color_xx) {
    catch {$k configure -font $glob(gui,ListBoxFont)}
  }
  foreach inst {left right} {
    setListBoxFont $glob(listbox,$inst) {$glob(gui,ListBoxFont)}
  }
  foreach class {Entry Text Listbox} {
    option add *$class.Font $glob(gui,ListBoxFont)
  }
  set glob(gui,ListBoxFont) $glob(gui,ListBoxFont)
  #
  foreach w [list $glob(win,top).status \
		 $glob(win,left).top.stat \
		 $glob(win,right).top.stat] { 
    $w  config -font $glob(gui,ListBoxFont)
  }
  # balloon window may not have been set up yet...
  primeBalloonHelp 0
}
##########################: Color management ################
# Arguments:
# color -	Name of starting color.
# perecent -	Integer telling how much to brighten or darken as a
#		percent: 50 means darken by 50%, 110 means brighten
#		by 10%. Default is lighter by 15%. 
# (shamelessly adapted from tk::Darken)

# proc LighterColor { color {percent 115}} {
#   lassign [winfo rgb . $color] r g b
#   set p [expr {$percent / 100.}]
#   foreach i {rr gg bb} c [winfo rgb . $color] {
#     set $i [expr {int(($c/256) * $p)}]
#     if {[set $i] > 255} {
#       set $i 255
#     }
#   }
#   return [format #%02x%02x%02x $rr $gg $bb]
# }
#
# In this version we use an absolute value (i.e. a % of the full range
# rather than the current value)

proc LighterColor2 { color {percent 115}} {
  lassign [winfo rgb . $color] r g b
  set p [expr {$percent < 100 ? -$percent * 2.56 : ($percent - 100) *2.56}]
  foreach i {rr gg bb} c [winfo rgb . $color] {
    set $i [expr {int(($c/256) + $p)}]
    if {[set $i] > 255} {
      set $i 255
    }
    if {[set $i] < 0} {
      set $i 0
    }
  }
  return [format #%02x%02x%02x $rr $gg $bb]
}


# The following is shamelessly lifted from tk_setPalette which we
# don't use because we only want to do selected widgets, by class

proc makePalette {bg cnames result {fg {}}} {
  upvar $result new
  upvar $cnames colornames

  # we build these color names:
  set colornames [list foreground background selectBackground troughColor \
		      highlightBackground activeForeground selectForeground \
		      selectColor highlightColor disabledForeground \
		      activeBackground ]
		      
  lassign [winfo rgb . $bg] bg_r bg_g bg_b
  # r g & b range 0-65535 and your eyes are more sensitive to
  # green than to red, and more to red than to blue.
  set new(background) $bg
  set new(foreground) $fg
  if {$fg == {}} {
    # foreground will be either black or white depending on 
    # perceived brightness of the bg.
    if {$bg_r+1.5*$bg_g+0.5*$bg_b > 100000} {
      set new(foreground) black
    } else {
      set new(foreground) white
    }
  }
  set new(selectBackground) \
      [format #%02x%02x%02x [expr {(9*$bg_r)/2560}] \
	   [expr {(9*$bg_g)/2560}] [expr {(9*$bg_b)/2560}]]

  # do we need this????
  set new(troughColor) $new(selectBackground)
  set new(highlightBackground) $new(background)
  foreach i {activeForeground  \
		 selectForeground highlightColor} {
    set new($i) $new(foreground)
  }
  lassign [winfo rgb . $new(foreground)] fg_r fg_g fg_b
  ##  ??
  set new(disabledForeground) [format #%02x%02x%02x \
				   [expr {(3*$bg_r + $fg_r)/1024}] \
				   [expr {(3*$bg_g + $fg_g)/1024}] \
				   [expr {(3*$bg_b + $fg_b)/1024}]]
  set new(activeBackground) [LighterColor2 $bg]
  set new(selectColor) $new(activeBackground)
  return 
}

# colorBaseLine is basically a been here for each color.
# we set it to the given color as we do the work of updateing each.
# If args != {} we do all the colors, otherwise only those that differ
# from the baseLine (or if the baseLine does not yet exist.

proc ReConfigColors {args} {
  global glob config beenHere colorBaseLine
  unset -nocomplain beenHere
  set do {}
  primeBalloonHelp 0
  foreach c {color_scheme color_bg color_fg color_select_bg\
		 color_select_fg color_cursor color_cmd \
		 color_highlight_fg color_highlight_bg \
		 color_handle} {
    if {![info exist colorBaseLine($c)] ||\
	    $colorBaseLine($c) != $glob(gui,$c) || \
	    $args != {} || \
	    $c in $do} {
      switch $c {
	color_scheme {
	  set Cl {Button Checkbutton Menubutton Radiobutton Canvas
		      Scrollbar Label Menu TextMenu Frame Scale Dialog}
	  makePalette $glob(gui,$c) cols new
	  foreach cl $cols {
	    setOptionF $Cl [list .tkcon.* *Tear*] $cl $new($cl)
	  }
	  # gui exceptions... here we undo what we want different

	  # bit of a conflict between the Menu and the Checkbutton/Radiobutton
	  setOptionF {Menu TextMenu} [list .tkcon.* *Tear*] selectColor $new(foreground)
	  # set the special middle button colors, if any
	  # this is needed as we just reset all the button colors and now
	  # need to reset those s/he would like to be unique
	  setMidButColor
	  # let the other color sections take the Label and handles..
	  # this line requires that 'color_scheme' is before these in
	  # the foreach loop.
	  lappend do color_fg color_bg color_handle
	}
	color_bg {
	  # frputs  glob(gui,$c)
	  setOption background $glob(gui,$c)
	  doWidget .fupper Label [list .fupper.ftop* .fupper.*.top.s* .tkcon.*] $args\
	      "\[set wd] config -background $glob(gui,$c)"
	  # The status widget is a text widget we want to look like a label
	  $glob(win,top).status config -bg $glob(gui,color_scheme)
	}

	color_fg {
	  setOption foreground $glob(gui,$c)
	  doWidget  .fupper Label [list .fupper.ftop* .fupper.*.top.s* .tkcon.* ] $args\
	      "\[set wd] config -foreground $glob(gui,$c)"
	}

	color_select_fg	{
	  setOption selectForeground $glob(gui,$c)\
	      {Entry Listbox Text TextMenu}
	  setOption activeForeground $glob(gui,$c)

	  foreach inst {left right} {
	    $glob(win,bottom).fcmdwin$inst.text tag config complete \
	  	-foreground $glob(gui,$c)
	  }
	}

	color_select_bg	{
	  setOption activeBackground $glob(gui,$c)
	  setOption {selectBackground inactiveSelectBackground}\
	      $glob(gui,$c) {Entry Listbox Text TextMenu}
	  foreach inst {left right} {
	    $glob(win,bottom).fcmdwin$inst.text tag config complete \
	  	-background $glob(gui,$c)
	  }
	}
	color_cursor {setOption insertBackground $glob(gui,$c)}
	color_cmd {
	  foreach inst {left right} {
	   $glob(win,bottom).fcmdwin$inst.text tag config command  \
	       -background $glob(gui,$c)
	  }
	}
	color_highlight_fg -
	color_highlight_bg {
	  if {$glob(select_pry_lr) != {}} {
	    twidleHighlight $glob(select_pry_lr) on $glob(select_pry_s)
	  }
	  setOption [expr {$c == "color_highlight_fg" ? "highlightColor" : \
			       "highlightBackground"}] $glob(gui,$c)
	}
	color_handle {
	  catch {
	    $glob(listbox,left)  config -bg $glob(gui,color_handle)
	    $glob(listbox,right) config -bg $glob(gui,color_handle)
	  }
	}
      }
    }
    set colorBaseLine($c) $glob(gui,$c)
  }

}

proc setOption {ops val {class {Entry Listbox Text}} } {
  setOptionF $class [list .tkcon.* *Tear*] $ops $val
} 

proc setOptionF {class except ops val} {  
  foreach op $ops {
    foreach clas $class {
      # frputs clas op val
      option add *$clas.$op $val 90
      # puts "set option *$class.$op $val"
    }
    doWidget . $class $except {}\
	"\[set wd] config -[string tolower $op] $val"
  }
}

# This function executes the passed in script on each widget in the process
# that is in the given class list and not in the given except list
# It keeps a list of the qualifying windows so any subsequent run is
# faster.

proc doWidget {w class except new args} {
  global glob 
  if {![info exists beenHere($w,$class)] || $new == {}} {
    set beenHere($w,$class) [BuildSelectWidgetList $w $class $except]
  } else {
    # frputs "doWidget HAVE list for $w,$class "
  }
  foreach wd $beenHere($w,$class) {
    foreach arg $args {
	# frputs #2 #3 w class out
      set r [catch "eval $arg" out]
      if {$r != 0} {
      }
      # # debug only....
      # if {$r == 0 && [catch "$wd config -bitmap" out] == 0 && [lindex $out 4] != {} } {
      # 	puts "Changing $wd: [lindex $out 4]<>$arg"
      # }
      # # end debug
   }
  }
}


proc BuildSelectWidgetList {wd class except} {
  set rtn {}
  if {[patternListSearch $except $wd] == {} && [winfo class $wd] in $class} {
    lappend rtn $wd
  }
  foreach ch [winfo child $wd] {
    set localClass $class
    if {[winfo class $wd] == "TextMenu"} {
      # If this is a TextMenu eliminate Text from the list
      set localClass [lsearch -exact -all -not -inline $class "Text"]
    }
    set srtn [BuildSelectWidgetList $ch $localClass $except]
    if {$srtn != {} } {
      lappend rtn {*}$srtn
    }
  }
  return $rtn
}
# ============================= End of the Color and Font management stuff ======

#             'linux wish +source' 'linux fr'  'win wrap' 'win wish +source'
# info nameofex fpt wish             fpt wish   fr.exe      fpt wish
# argv0          ?  wish             ?   fr     \fr.exe     fpt wish
# glob(program)  ?  fr               fpt fr     wrap p fr   fpt fr
#
proc Clone  {} {
  global glob argv argv0
  cd  $glob(start_path)
  set target [file normalize [info nameofex]]
  set script [file norm [file join $glob(start_path) $glob(program)]]
  if {([file extension $target] == ".exe" && \
	  [string match -nocase *fr* [file tail $target]]) || \
	$target == $script  } {
    set script ""
  }
  frECF {exec %b &} [list $target $script $glob(left,pwd) $glob(right,pwd)]

}
	    
###########################: Command window stuff #####################

proc ToggleCmdWin { inst } {
  global glob config
  set w $glob(win,bottom).fcmdwin$inst
  if {$glob($inst,shell,grided)} {
    grid remove $w
    if {!$glob([Opposite $inst],shell,grided)} {
      grid remove $glob(win,bottom)
    } else {
      focus $glob(win,bottom).fcmdwin[Opposite $inst].bot.entry
    }
    set glob($inst,shell,grided) 0
    set glob($inst,shell,history,flipping) 0
  } else {
    if {!$glob([Opposite $inst],shell,grided)} {
      grid $glob(win,bottom)  -sticky news -row 6
    }
    $w.text configure -height $config(shell,height,$inst)
    set glob($inst,shell,maxed) 0
    grid $w -column 0 -sticky news -row [expr {$inst == "left" ? 10 : 20}]
    # grid rowconfig $w $w.text -weight 1
    # grid rowconfig $w $w.bot  -weight 0 -minsize 22
    set glob($inst,shell,grided) 1
    focus $w.bot.entry
  }
  update
  # grid command seems to forget this so we remind it.
  grid rowconfigure . 2 -weight 1
}

proc MaxWin {inst } {
  global glob config
  if {$glob($inst,shell,maxed)} {
    $glob(win,bottom).fcmdwin$inst.text configure \
	-height $config(shell,height,$inst)
    set glob($inst,shell,maxed) 0
  } else {
    # $glob(win,bottom).fcmdwin$inst.text configure -height 2000
    MaxCmdText $inst
    #set glob($inst,shell,maxed) 1
  }
}

# It seems that pack use to do this for us, but grid, not so much
# This routine computes and adjusts the given command window such
# that the command line will always be displayed. If the result is
# less than 1, it tries to take from the other command window
# (if it is open). This needs to be called when ever the command
# line is obscured. This may happen as a result of resizing
# either the main window or the command window.
# The total size of the text part of the command window must be
# less than: Main-window - other-cmd - bottom - bd of cmd and text


proc MaxCmdText {inst {rq 0}} {
  global glob config
  # rq is true if this is the result of pushing the button larger button
  
  set w $glob(win,bottom).fcmdwin
  
  set botSz [winfo height $w$inst.bot ]
  set mainSz [winfo height .]
  if {$glob([Opposite $inst],shell,grided)} {
    set otherSz [winfo height $w[Opposite $inst]]
  } else {
    set otherSz 0
  }
  set pixPerLine [font metric [$w$inst.text cget -font] -line]
  # frputs inst pixPerLine otherSz mainSz botSz
  set maxSz [expr {max(($mainSz - $otherSz - $botSz - 8) / $pixPerLine , 1)}]
  if {$rq} {
    $w$inst.text config -height [expr {min($config(shell,height,$inst),$maxSz)}]
    return
  }
  # Only mess with this if we are making it smaller...
  if {[$w$inst.text cget -height] <= $maxSz} {return}
  $w$inst.text config -height $maxSz
  set config(shell,height,$inst) [expr {min($config(shell,height,$inst),$maxSz)}]
  set glob($inst,shell,maxed) 1
  if {$maxSz == 1 && $otherSz > 1} {
    MaxCmdText [Opposite $inst]
  }
}

proc CmdWinVis {inst vis} {
  global glob
  # There is a timing issue here, lets try to smooth things out...
  set glob(lastVis) [list $inst $vis]
  if {[info exists glob(VisAfter)]} {
    after cancel $glob(VisAfter)
  }
  set glob(VisAfter) [after 500 CmdWinVisComp]
  # frputs vis
}

proc CmdWinVisComp {} {
  global glob
  unset -nocomplain glob(VisAfter)
  if {[info exists glob(lastVis)]} {
    lassign $glob(lastVis) inst obs
    if {$obs != "VisibilityUnobscured"} {
      MaxCmdText $inst
    }
  }
}
    
##############################: Build command windows ########################
proc BuildCmdWindow { inst } {
  global glob config

  set w $glob(win,bottom).fcmdwin$inst
  #destroy $w
  frame $w -bg green
  text $w.text \
      -relief sunken \
      -bd 2 \
      -yscrollcommand "$w.scroll set"\
      -font $glob(gui,ListBoxFont)
      # -height $config(shell,height,$inst) 
  lappend glob(winlist,color_xx) $w.text
  #frame $w.fr -bd 0
  scrollbar $w.scroll -command "$w.text yview"
  frame $w.bot -bd 0 -background yellow
  entry $w.bot.entry \
      -relief ridge \
      -font $glob(gui,ListBoxFont) \
      -highlightthickness 1 
  lappend glob(winlist,color_xx) $w.bot.entry
  # lappend glob(winlist,color_cmd) $w.text
  label $w.bot.label -textvariable glob($inst,pwdTail) \
      -relief ridge \
      -padx 5
      # -font $glob(gui,GuiFont)
  button $w.bot.max \
      {*}[getImage -bitmap max @$glob(lib_fr)/bitmaps/max.bit] \
      -command "MaxWin $inst" \
      -bd 1
  button $w.bot.smaller \
      {*}[getImage -bitmap smaller @$glob(lib_fr)/bitmaps/smaller.bit] \
      -command "
               incr config(shell,height,$inst) -2
               if \"\$config(shell,height,$inst)<1\" \"
                 set config(shell,height,$inst) 1
               \"
               $w.text configure -height \$config(shell,height,$inst)"\
      -bd 1
  button $w.bot.larger \
      {*}[getImage -bitmap larger @$glob(lib_fr)/bitmaps/larger.bit] \
      -command "incr config(shell,height,$inst) 2;\
               MaxCmdText $inst 1" \
      -bd 1
 
  label  $w.bot.running -text [_ "R"]
  
  #grid rowconfigure $w all -weight 0
  grid rowconfigure $w 2 -minsize 20
  grid rowconfigure $w 1 -weight 1
   
  grid $w.scroll -row 1 -column [expr {$inst == "left" ? 0 : 2}] -sticky ns
  grid $w.text   -row 1 -column 1 -sticky news
  #grid rowconfig $w $w.text -weight 1
  #grid columnconfigure $w 
  #pack $w.fr -side $inst -fill y
  set fixedR [list  $w.bot.label $w.bot.entry \
		  $w.bot.running $w.bot.smaller $w.bot.larger $w.bot.max]
  foreach win $fixedR {
    grid $win -row 0 -column [incr col] -sticky ew
    grid columnconfig $w.bot $col -weight [expr {$col == 2 ? 1 : 0}]
      
  }
  grid $w.bot  -row 2 -column 0 -columnspan 4 -sticky ew
  # grid rowconfig $w 2 -weight 0 -minsize 22
  grid columnconfig $w all -weight 0
  grid columnconfig $w 1  -weight 1
  
  #grid rowconfigure $w 1 -weight 1
  
  bind $w.bot <Visibility> [list CmdWinVis $inst %s]

  textSearch $w.text [_ "Cmd %s" $inst] "+buildViewConfig CmdConfStrings" {} \
      [list  {Save As...} [list ? "SaveToFile $w.text {} 1 " -accelerator C-S]]
  # Lower case C-s usually means we have file, but we don't so sent to C-S
  bind $w.text      <Control-s> "SaveToFile $w.text {} 1 "
  bind $w.text      <Control-S> "SaveToFile $w.text {} 1 "
  # since we don't focus on this window, we need the binds on the one we do
  bind $w.bot.entry <Control-s> "SaveToFile $w.text {} 1 "
  bind $w.bot.entry <Control-S> "SaveToFile $w.text {} 1 "
  set nspace [regsub -all {\.} $w.text {_}]_Sp
  bind $w.bot.entry <F3>        [list ::${nspace}::SearchView    $w.text "+buildViewConfig" 1]
  bind $w.bot.entry <Shift-F3>  [list ::${nspace}::SearchView    $w.text "+buildViewConfig" 2]
  bind $w.bot.entry <Control-f> [list ::${nspace}::SearchViewSet $w.text "+buildViewConfig" 0]
 
  bind $w.bot.entry <Return> \
      "ExecCmdInWin $inst $w; catch \"focus $w.bot.entry\" out;break"
  bind $w.bot.entry <KP_Enter> \
      "ExecCmdInWin $inst $w;catch \"focus $w.bot.entry\" out; break"
  bind $w.bot.entry <Tab> "preComplete $inst $w;break"
  bind $w.bot.entry <Control-d> "CompleteDoubleTab $w.bot.entry;break"
  bind $w.bot.entry <Control-p> "FlipShellHistory $w.bot.entry $inst searchback
                                 break"
  bind $w.bot.entry <Control-c> "DoControlCthing $w $inst;break"
  bind $w.bot.entry <Up> "FlipShellHistory $w.bot.entry $inst up;break"
  bind $w.bot.entry <Down> "FlipShellHistory $w.bot.entry $inst down;break"
  bind $w.bot.entry <3> "CompleteWithBrowse $w.bot.entry;break"

  #bind $w.text <3> "tk_popup $w.text.p %X %Y;break"
  
  # The following 4 lines cause a disturbing issue where mouse entry raises the
  # main window and thus obscuring any window above it. On my system focus now
  # comes after a hover without raising the main window.
  
  # bind $w.bot.entry <Enter> "focus $w.bot.entry"
  # bind $w.bot.entry <Leave> "focus ."
  # bind $w.text <Enter> "focus $w.bot.entry"
  # bind $w.text <Leave> "focus ."

  # The following causes focus events in the command window to give focus to the
  # command line.
  bind $w.text <FocusIn> "focus $w.bot.entry"
  # In windows the MouseWheel events are delivered to the window that
  # has focus. Since (because of the above <Enter> sequence) the text
  # window MouseWheel events will be delivered to the entry window.
  # Thus the following actually works (Magic enough for you?).
  bind $w.bot.entry <MouseWheel>  "$w.text yview scroll \
                          \[expr %D > 0 ? -\$config(mwheel,delta) : \
                          $config(mwheel,delta)] units;break"
  # In linux, it would appear that the following are not needed, however,
  # if we want to control the scroll distance, well...
  bind $w.text $config(mwheel,neg) \
      "$w.text yview scroll \
       -\$config(mwheel,delta) units;break"
  bind $w.text \
      $config(mwheel,pos) \
      "$w.text yview scroll \
       \$config(mwheel,delta) units;break"
  bind $w.bot.entry $config(mwheel,neg) \
      "$w.text yview scroll \
       -\$config(mwheel,delta) units;break"
  bind $w.bot.entry \
      $config(mwheel,pos) \
      "$w.text yview scroll \
       \$config(mwheel,delta) units;break"
  # The following give up focus when the mouse leaves. As, in general
  # the list boxes do not take focus on entry this prevent characters
  # entered in the list box area from appearing in the command line.
  bind $w <Leave> {focus .}
  # And the following puts the focus on the entry window when ever the
  # mouse is in the entry window.
  bind $w.bot.entry <Enter> "focus $w.bot.entry"
}
#####################: End of command window build ##################


# Here we close the channel that is controlling the shell
# We always close the first entry and the command puts
# new entries last, thus we always do the oldest first.
# the command code needs to remove entries in random order depending
# of the order of compeltion.  
# We assume serial running, i.e. the command will not interrupt us
# with its completion, thus no locks are needed.

proc DoControlCthing { w inst } {
  global glob
  if {  [$w.bot.entry get] != "" } {
    $w.bot.entry delete 0 end
  } else {
    if { [info exists glob($inst,fid)] && [llength $glob($inst,fid)]} {
      set fi [lrange $glob($inst,fid) 0 0]
      Log [_ "^C on %s" $glob($inst,fid)]
      pipeoAbort $fi
    } else {
      Log [_ "Command does not exist"]
    }
  }
}


proc buildViewConfig {{which {}}} {
  global config glob
  set vl {}
  if {$which !={}} {
    set vl [list values ::config(search,$which)\
		valueCount $config(search,limit)]
  }
  return  [list -flashcolor $glob(gui,color_flash)\
	      -foreground $glob(gui,color_select_fg)\
	      -background $glob(gui,color_select_bg)\
	      -state disabled\
	       position cent\
	       {*}$vl
	      ]
}
proc buildDialogConfig {} {
  global  config glob
  set maxw [expr {70 * [font measure $glob(gui,ListBoxFont) {0}]}]
  return [list -font $glob(gui,ListBoxFont) \
	      -foreground $glob(gui,color_select_fg)\
	      -background $glob(gui,color_select_bg)\
	      -width 70 \
	      -state disabled\
	      position cent\
	      maxw $maxw]
}

proc preComplete {inst w} {
  global glob config
  if { [catch {cd $glob($inst,pwd)} out]} {
    PopError "$out"
    return ""
  }
  Complete $w.bot.entry $w.text $config(shell,aliases) \
      $glob(localCmds) type
}

proc CmdType {w inst args} {
  global env config glob
  foreach ag $args {
    foreach arg $ag {
      set indx [lsearch -exact -index 0 $config(shell,aliases) $arg]
      if {$indx != -1} {
	ToShellBuffer $w "[_ {%s is aliased to} $arg] \
                        `[subst [lindex $config(shell,aliases) $indx 1]]'\n"
	continue
      }
      set indx [lsearch -exact $glob(localCmds) $arg]
      if {$indx != -1} {
	ToShellBuffer $w [_ "%s is a filerunner builtin\n" $arg]
	continue
      }
      if {$::MSW} {
	ToShellBuffer $w "[auto_execok $arg]"
      } else {
	set cmd [list {*}$config(cmd,sh) "type $arg"]
      
      	lassign [pipeoExec "$cmd 2>@1" r \
		     [list "backTalk $inst $w"]] r fid

	#set r [catch {open "|$config(cmd,sh)  \{$cmd 2>&1\}" r} fid]
	if {$r} {
	  ToShellBuffer $w [_ "Exec error: %s\n" $fid]
	} else {
	  incr glob($inst,shellcount)
	  set glob($inst,runlabel,bg) [$w.bot.running cget -bg]
	  $w.bot.running configure -bg red
	  lappend glob($inst,fid) $fid
	  vwait glob($inst,shellcount)
	}
      }
    }
  }
}

########################################: execute command in cmd window ##############
proc ExecCmdInWin { inst w } {
  global glob config env errorInfo
  #  focus $w.bot.entry
  destroy $w.bot.complete
  set glob($inst,shell,history,flipping) 0
  set glob($inst,shell,complete,flipping) 0
  set cmd [string trim [$w.bot.entry get]]
  if {$cmd == ""} return
  $w.bot.entry delete 0 end
  $w.text mark set insert end
  $w.text see insert
  if {[set idx [lsearch -exact $glob($inst,shell,history) $cmd]] != -1} {
    set glob($inst,shell,history) [lreplace $glob($inst,shell,history) $idx $idx]
  }
  lappend glob($inst,shell,history) $cmd
  
  if { [IsVFS $glob($inst,pwd)] } {
    set r [catch {VFScd $glob($inst,pwd)} out]
  } else {
    set r [catch {cd $glob($inst,pwd)} out]
  }
  if {$r } {
    PopError "$out"
    return
  }
  # use double quotes to round up the spaces...
  # We have to be VERY careful not to use list structure things here
  # as they introduce {}'s and miss handle []'
  # we want to convert 'x\ y' to '"x y"'
  # AND we want to convert other '\' so that they stay around...
  # Mostly for Windows

  set cmd [bslashSpcToQuot $cmd]
  set r [catch {set verb [lindex $cmd 0]} out]
  if {$r } {
    ToShellBuffer $w "\n$glob($inst,pwdTail) > $cmd\n" 1
    eval {ToShellBuffer $w [_ "tcl error: %s" $out]}
    if {$glob(debug)} {
      ToShellBuffer $w $::errorInfo
    }
    return
  }
  # expand aliases
  set alias ""
  foreach k $config(shell,aliases) {
    if {$verb == [lindex $k 0]} {
      set alias [subst [lindex $k 1]]
      break
    }
  }
  if {$alias != ""} {
    # This way of replacing 'verb' does not mess with the quoted
    # spaces.
    set cmd [regsub $verb $cmd $alias]
    set verb [lindex $cmd 0]
  }
  # echo command to the window
  ToShellBuffer $w "\n$glob($inst,pwdTail) > $cmd\n" 1
  update
  set len [llength $glob($inst,shell,history)]
  if {$len > 250} {
    set glob($inst,shell,history) \
	[lrange $glob($inst,shell,history) [expr $len - 200] end]
  }
  set prefix " "
  Log [_ "switch on %s" $verb]
  switch -glob $verb { 
    %* {
      # Tcl commands
      set prefix "Tcl: "
      set r [catch { 
	uplevel #0 [string range [regsub {\\} $cmd {\\\\}] 1 end] } out]
      if {$r} {
	ToShellBuffer $w [_ "tcl error: %s" $out]
	if {$glob(debug)} {
	  ToShellBuffer $w  "$errorInfo"
	}
      } else {
	ToShellBuffer $w "$out"
      }
    }
    cd {
      # this code is a little extra fluffy, because we want 
      # to avoid the error handling in NewPwd/UpdateWindow
      # which we could have used also, but it doesn't look 
      # as neat. (It pops up an error popup...)
      Log "cd"
      set newpwd [lindex $cmd 1]
      if {[IsVFS $glob($inst,pwd)]} {	
	ToShellBuffer $w [_ "cd not supported as a\
                             shell command in VFS directories"]
	#	  NewPwd $inst $newpwd
	#	  UpdateWindow $inst
	#	  ToShellBuffer $w [_ "ok"]
      } else {
	if {$newpwd == ""} {set newpwd $env(HOME)}
	set r [catch {cd $newpwd} out]
	if {!$r} {
	  set r [catch {cd $glob($inst,pwd)} out]
	  NewPwd $inst $newpwd
	  UpdateWindow $inst
	  ToShellBuffer $w [_ "ok"]
	} else {
	  ToShellBuffer $w [_ "cd error: %s" $out]
	}
      }
    }
    view {
      Log $cmd
      if {[IsVFS $glob($inst,pwd)]} {	
	ToShellBuffer $w [_ "view not supported as \
                             shell command in VFS directories"]
      } else {
	ViewAny [lrange $cmd 1 end]
      }
    }
    history {
      Log [_ "history"]
      ToShellBuffer $w [join $glob($inst,shell,history) \n]
    }
    which -
    type {
      Log $cmd
      CmdType $w $inst [lrange $cmd 1 end]
    }
    
    default {
      Log [_ "\"%s\" default" $cmd]
      # check for special commands...
      #  a background command?
      # Note: this sneaks through to the local system even if VFS
      if {[string match *& $cmd]} {
	set prefix [_ "Background shell: "]
	catch {puts "$cmd"}
	set cmd [regsub {\\} $cmd {\\\\}]
	set cmd [string replace $cmd end end]
	if {$::MSW && $config(cmd,sh) == {}} {
	  set pre [lindex $cmd 0]
	  set cmd [string trim [regsub $pre $cmd {}]]
	  set r [frECF "exec $pre %b &" [list {*}$cmd] -b 1]
	  # set r [catch [list fixMSWcommand "exec $pre %b &" $cmd -b 1] out]
	} else {
	  catch {eval exec "$cmd &"} out
	}
	if {$out != 0} {
	  ToShellBuffer $w $out
	}
      } elseif {[IsVFS $glob($inst,pwd)] } {
	set prefix [_ "VFS command: "]
	ToShellBuffer $w [VFScommand $VFStok $cmd]
      } else {
	# not "&" and not VFS
	set prefix [_ "Shell: "]
	if {$glob(os) == "Unix"} {
	  set cmd [regsub -all {\\} $cmd {\\\\}]
	}
	if {$::MSW} {
	  if {$config(cmd,sh) == {}} {
	    # puts "Send this $cmd"
	    set pre [lindex $cmd 0]
	    set cmd [string trim [regsub $pre $cmd {}]]
	    # frputs pre cmd
	    set r [catch {frECF "$pre %s" [list {*}$cmd] -f 1 -w 1 -x 1} cmd ]
	    # set r [catch [list fixMSWcommand [list $pre] $cmd -fonly 1] cmd]
	    # puts "This command $cmd"
	    if {$r != 0} {
	      ToShellBuffer $w $cmd
	      return
	    }
	  } else {
	    set cmd [frECF "$config(cmd,sh) %s" [list $cmd] -f 1 -w 1 -x 1]
	    # set cmd [fixMSWcommand "$config(cmd,sh)" $cmd -fonly 1]
	    #set cmd [regsub -all {\\} $cmd {\\}]
	  }
          frputs "To pipeoExec: "  cmd
          lassign [pipeoExec " $cmd 2>@1" r \
                       [list "backTalk $inst $w"]] r fid
          
        } else {
	  # not windows...
	  # lets tear this up and rebuild it so we can seperate the files
	  # from the commands...
	  # We are going to defer most of this to frECF. What we need to
	  # do here is try to handle standard command line quoting. This
	  # includes both """ and "'" as quoting chars.
	  # Remember these are strings, NOT list elements. Spaces separate
	  # elements if they are not quoted and of course we have backslashes.
          set cmd [regsub -all {\||\|&} $cmd { & }]

          frputs "To pipeoExec: " config(cmd,sh) cmd
          lassign [pipeoExec "$config(cmd,sh) [list $cmd 2>@1]" r \
                       [list "backTalk $inst $w"]] r fid
        }
        if {$r} {
	  ToShellBuffer $w [_ "Exec error: %s\n" $fid]
	} else {
	  incr glob($inst,shellcount)
	  if {$glob($inst,shellcount) == 1} {
	    set glob($inst,runlabel,bg) [$w.bot.running cget -bg]
	    $w.bot.running configure -bg red
	  }
	  lappend glob($inst,fid) $fid
	}
      }
    }
  }
  Log $prefix$cmd
}

proc backTalk {inst w fid why {mess {}}} {
  global glob
  switch -glob $why {
    a*  -
    en* -
    k*  -
    do*  {
      Log "Shell pipe: $why $mess"
    }
    da*  {
      ToShellBuffer $w $mess
    }
    eo*  {
      set id [lsearch -exact $glob($inst,fid) $fid]
      if { $id >= 0 } {
	set glob($inst,fid) [lreplace $glob($inst,fid) $id $id]
      }
      incr glob($inst,shellcount) -1
      if {$glob($inst,shellcount) == 0} {
	$w.bot.running configure -bg $glob($inst,runlabel,bg)
      }
    }
  } 
}


proc ToShellBuffer { w  chars {cmd 0}} {
  global config
  $w.text insert end $chars
  if { $cmd } {
    $w.text tag add command "insert - 1 lines" "insert - 1 chars"
  }
  set size_text [file rootname [$w.text index end]]
  if {$size_text > [expr ($config(shell,buffer) * 4) / 3]} {
    $w.text delete 0.1 [expr ${size_text} - $config(shell,buffer)].1
  }
  $w.text see "insert - 1 chars"
}

proc ReadDelay { i } {
  #puts -nonewline "@"
  flush stdout
  set len [expr 200 + ($i * 50)]
  if {$len > 1000} {set len 1000}
  return $len
}


proc FlipShellHistory { w inst direction } {
  global glob
  # frputs "flip  " direction
  switch $direction {
    up {
        if {!$glob($inst,shell,history,flipping)} {
          set glob($inst,shell,history,flipping,index) \
	      [expr [llength $glob($inst,shell,history)] - 1]
          set glob($inst,shell,history,flipping) 1
        } else {
          incr glob($inst,shell,history,flipping,index) -1
          if {$glob($inst,shell,history,flipping,index) < -1} {
	    set glob($inst,shell,history,flipping,index) -1
	  }
        }
      }
    down {
        if {!$glob($inst,shell,history,flipping)} {
          set glob($inst,shell,history,flipping,index) 0
          set glob($inst,shell,history,flipping) 1
        } else {
          incr glob($inst,shell,history,flipping,index) 1
          set len [llength $glob($inst,shell,history)]
          if {$glob($inst,shell,history,flipping,index) > $len} {
	    set glob($inst,shell,history,flipping,index) [expr $len]
	  }
        }
      }
    searchback {
      set cmd [string trim [$w get]]
        if {$glob($inst,shell,history,flipping) && \
	    [string first $glob($inst,shell,history,flipping,cmd) $cmd] == 0} {
	  # been here before with same command
	  set cmd $glob($inst,shell,history,flipping,cmd)
	  set start [expr $glob($inst,shell,history,flipping,index) -1]
          if {$start < -1} {set start -1}
          #set cmd $glob($inst,shell,history,flipping,cmd)
        } else {
	  # first time here, save current cmd line
          set start [expr [llength $glob($inst,shell,history)] - 1]
          set glob($inst,shell,history,flipping,cmd) $cmd
         }
#        puts "$cmd $start"
        for {set i $start} {$i >= 0} {incr i -1} {
	  if {[string first $cmd [lindex $glob($inst,shell,history) $i]] == 0} {
            set glob($inst,shell,history,flipping,index) $i
            set glob($inst,shell,history,flipping) 1
            break
          }
        }
        if {!$glob($inst,shell,history,flipping)} return
      }
  }
  $w delete 0 end
  $w insert end [lindex $glob($inst,shell,history) \
		     $glob($inst,shell,history,flipping,index)]
}
##########################: End of the Command window code ##############


proc CheckGrab { r reason } {
  if {$r} {
    LogStatusOnly [_ "%s (non fatal)" $reason]
  }
}

# This routine is for commands that don't want the autoupdater to run
# and invoke "update" during operation
proc DoProtCmd { cmd } {
  DoProtCmd_ $cmd
}
proc DoProtCmd_NoGrab { cmd } {
  DoProtCmd_ $cmd 1
}

proc DoProtCmd_ {cmd {nograb 0}} {
  global glob DoProtLevel
  if {! $nograb} {
    focusToCmd
    frgrab $glob(win,top).menu_frame.fasync_cmds
  }
  set glob(doprot,$DoProtLevel) \
      [list [. cget -cursor] $glob(enableautoupdate)]
  incr DoProtLevel
  lappend ::DoProtProc $cmd
  set ::MaxDoProtLevel [expr {max($DoProtLevel,$::MaxDoProtLevel)}]
  # if { ! [info exists glob(oldcur)] || [. cget -cursor] != $glob(oldcur)} {
  #   set glob(oldcur) [. cget -cursor]
  # }
#  puts "saved $glob(oldcur) $cmd"
  # set glob(oldautoup) $glob(enableautoupdate)
  ::cursor::propagate . circle
  ::cursor::restore $glob(win,top).menu_frame.fasync_cmds arrow
  update idletasks
  if {$glob(enableautoupdate) != 0} {
    # we do this to avoid extra trace calls (see list updater)
    set glob(enableautoupdate) 0
  }
  uplevel 2 $cmd
  UnDoProtCmd
}

# This is used by the continue button after an error...
proc UnDoProtCmd { } {
  global glob config DoProtLevel
  if {!$DoProtLevel} {return}
  incr DoProtLevel -1
  condResetAbt
  set ::DoProtProc [lrange $::DoProtProc 0 end-1]
  lassign $glob(doprot,$DoProtLevel) curser update
  if {$update != $glob(enableautoupdate) } {
    set glob(enableautoupdate) $update
  }
  set glob(async) 0
  ::cursor::propagate . arrow
  #. config -cursor $curser
#  puts "set $glob(oldcur)"
  catch {grab release [grab current $glob(win,top).menu_frame.fasync_cmds]}
  #catch {focus $glob(focus_before_doprotcmd)}
  unset -nocomplain glob(whichdir)
  # Not sure if the following line is needed.  By not having it we can
  # do much more with Left & Right Up & Down keys even in normal mode.
  if {$config(focusFollowsMouse) != 1} {
    focusToCmd
  }
  set glob(mbutton) 0
}
# This prefers to give focus the current pane
proc focusToCmd {} {
  global glob
  set inst $glob(select_cur_lr)
  if {$inst == {}} {
    set inst "right" 
    if {[file norm $glob(left,pwd)] == [pwd]} {set inst left}
  }
  if {$glob($inst,shell,grided)} {
    focus $glob(win,bottom).fcmdwin$inst.bot.entry
  } elseif {$glob([Opposite $inst],shell,grided)} {
    focus $glob(win,bottom).fcmdwin[Opposite $inst].bot.entry
  } else {
    focus $glob(win,top).status
  }
}
#
# This is for the simple case where we just want to protect things like
# entry_dialog.  We just turn off the updateing and in addition allow
# a return value.  We do NOT mess with grab and focus...
#
# proc simpDoProt {cmd} {
#   global glob DoProtLevel
#   set glob(doprot,$DoProtLevel) [list [. cget -cursor] $glob(enableautoupdate)]
#   incr DoProtLevel
#   lappend ::DoProtProc "$cmd -S"
#   if {$glob(enableautoupdate) != 0} {
#     # we do this to avoid extra trace calls (see list updater)
#     set glob(enableautoupdate) 0
#   }
#   set rt [uplevel $cmd]
#   lassign $glob(doprot,[incr DoProtLevel -1]) cursor update
#   set ::DoProtProc [lrange $::DoProtProc 0 end-1]
#   if {$update != $glob(enableautoupdate) } {
#     set glob(enableautoupdate) $update
#   }
#   . config -cursor $curser
#   return $rt
# }

proc SetStartDir { inst } {
  global glob config
  set config(startpwd,$inst) $glob($inst,pwd)
  LogStatusOnly [_ "% set. Do\
       \"Configuration->Save configuration\" if\
        you want to store it to the .fr file" sconfig(startpwd,$inst)]
  #SaveConfig
}

proc SetWinPos {} {
  global glob config
  if {[wm grid .] == {}} {
    set config(geometry,main) [wm geo .]
  } else {
    set config(geometry,main) [getGeo g[wm geometry .] . -out p]
  }
  SaveConfig
}

proc ConstructFileList { inst } {
  global glob config
  set dirlist $glob($inst,filelist)
  set dir $glob($inst,pwd)

  foreach flist $glob(listboxNames) {
	 set glob($inst,lv$flist) {}
  }
  foreach k $dirlist {
    # puts "$k"
    # assemble the bits the scripts will need.
    #lassign $k sortval file type size mtime mode usergroup link nlink atime ctime
    lassign $k {*}$glob(fListEl)
    #frputs file type
    set ffile $file[switch -glob -- $type {
      *ld {expr {"@/"}} 
      *d  {expr {[string index $file end] == "/" ? "" : "/"}} 
      *l  {expr {"@"}} 
      *n  {expr {""}} 
    }]
    if {$size == {}} {
      set ffile "${ffile}??"
    }
    foreach lbentry $config(ListBoxColumns,$inst) {
      set flist [lindex $lbentry 0]
      lappend glob($inst,lv$flist) [eval $glob(lbscript,$flist)]
    }
  }
}

proc InitWindows {} {
  global glob
  set glob(select_cur_lr) {}
  set glob(select_pry_s) {}
  set glob(select_cur_s) {}
  highlightOff
  #UpdateWindow both
}

proc Back { inst } {
  global glob
  while {[llength $glob($inst,dirstack)] > 0 } {
    set dir [lindex  $glob($inst,dirstack) 0 0]
    if {$dir == $glob($inst,pwd)} {
      # if {[llength $glob($inst,dirstack)] == 1} break
      set glob($inst,dirstack) [lrange $glob($inst,dirstack) 1 end]
       frputs dir glob($inst,dirstack)
      continue
    }
      frputs dir glob($inst,dirstack)
    NewPwd $inst $dir
    UpdateWindow $inst
    set glob($inst,dirstack) [lrange $glob($inst,dirstack) 2 end]
    frputs dir glob($inst,dirstack)
    break
  }
  #puts "back: $glob(left,dirstack)\n$glob(right,dirstack)\n"
}

proc ForceUpdate {{inst  both}} {
  global glob
  set glob(forceupdate) 1
  UpdateWindow $inst
  set glob(forceupdate) 0
}

proc ButtonAdd {w inst args} {
  global glob config
  # each element in args generates a menu entry
  # If the first char is '+' the command is added to the buttoncmds list.
  # if an entry is empty a separator is generated
  # if an entry contains -o (part of -on or -off) a check button is generated
  # if neither of the above a command button is generated.
  # if an entry contains $inst, it is replaced with the inst parm value
  # if an entries -command argument contains NP a call to DoProtCmd is NOT prepended
  foreach arg $args {
    foreach ent $arg {
      set butCmd 0
      if {[string index $ent 0] == "+"} {
	set ent [string range $ent 1 end]
	incr butCmd
      }
      array unset tmp
      frputs ent
      array set tmp $ent
      set tmp(-label) [subst $tmp(-label)]
      if {[string match {NP *} $tmp(-command)]} {
	set tmp(-command) [regsub {NP } $tmp(-command) {}]
      } else {
	set tmp(-command) "DoProtCmd [list $tmp(-command)]"
      }
      set tmp(-command) [regsub {\$inst} $tmp(-command) "$inst"]
      set ent [array get tmp]
      set type [expr {[string match {* -o*} $ent] ? "check" :
		      [string match {* -value*} $ent] ? "radio" : "command"}]
      $w add $type {*}$ent
      # puts "$ent"
      if {$butCmd && [list $tmp(-label) $tmp(-command)] ni $glob(buttoncmds)} {
	lappend glob(buttoncmds) [list $tmp(-label) $tmp(-command)]
      }
    }
  }
}

proc BuildFileListPanel { inst } {

  global glob config

  frame $glob(win,$inst) -borderwidth 1 -relief raised
  set wf [frame $glob(win,$inst).dirmenu_frame -borderwidth 1 -relief raised]
  set wft [frame $glob(win,$inst).top -bd 1 -relief raised]
  # frame $wft.t -bd 0 -relief raised

  # The tree button (code is in frUnixBits as MSW version of tk does not
  # support the required cascade.
  buildTree $wf $inst
  
  # Hotlist button
  menubutton $wf.hotlist_but -takefocus 0 -menu \
      $wf.hotlist_but.m -text [_ "Hotlist"]
  bind $wf.hotlist_but <Motion> {+
    if {$::tk::Priv(postedMb) == "%W"} {
      set ::tk::Priv(menuActivated) 1
    }
  }
    
  # by specifying tk_popup here we get the desired cascade action
  #bind $wf.hotlist_but <1> "::tk_popup $wf.hotlist_but.m %X %Y; break"
  startProc "Start TEXTMENU $inst"
  if {$::tcl_platform(os) == "Darwin"} {
    # Our textmenu does not work in Darwin ... Yet.
    set menuType "menu"
  } else {
    package require textmenu
    set menuType "textmenu"
  }
  $menuType $wf.hotlist_but.m  \
      -tearoff true  -postcommand "CreateHotListMenu $inst"
  # -font $glob(gui,GuiFont)
  startProc "End TEXTMENU $inst "
  # History button  
  menubutton $wf.history_but -menu \
      $wf.history_but.m -text [_ "History"]

  menu $wf.history_but.m \
      -tearoff false -postcommand "CreateHistoryMenu $inst"
  # -font $glob(gui,GuiFont)
  # Etc button
  menubutton $wf.etc_but -takefocus 0 -menu \
      $wf.etc_but.m -text [_ "Etc"]
  # Build the Etc menu
  menu $wf.etc_but.m -tearoff false \
      -postcommand "CreateEtcMenu $wf.etc_but.m $inst"
  # -font $glob(gui,GuiFont)

  # Create buttons
  #  the ^ button
  buttonWbitmap $wf.button_parentdir \
      -relief raised \
      -borderwidth 1\
      {*}[getImage -bitmap up @$glob(lib_fr)/bitmaps/up.bit] \
      -command "UpDirTree $inst %X %Y"
  
  # the <- button
  button $wft.button_back -takefocus 0 -borderwidth 1 \
      {*}[getImage -bitmap left @$glob(lib_fr)/bitmaps/left.bit] \
      -command  "DoProtCmd \"  Back ${inst}\"" -width 22
  
  # Start a terminal program button
  button $wft.button_xterm -takefocus 0 \
      -borderwidth 1 \
      {*}[getImage -bitmap xterm @$glob(lib_fr)/bitmaps/xterm.bit] \
      -command "StartTerm  $inst"

  # The command at the bottom button
  button $wft.button_frterm -takefocus 0 \
      -borderwidth 1\
      {*}[getImage -bitmap frterm @$glob(lib_fr)/bitmaps/frterm.bit] \
      -command "ToggleCmdWin $inst"

  # The update button
  button $wft.button_update -takefocus 0 \
      -borderwidth 1\
      {*}[getImage -bitmap update @$glob(lib_fr)/bitmaps/update.bit] \
      -command \
      "DoProtCmd \"set glob(forceupdate) 1; \
       UpdateWindow $inst; set glob(forceupdate) 0\""

  # The dir line window
  entry $glob(win,$inst).entry_dir -takefocus 0 \
      -relief {ridge} \
      -font $glob(gui,ListBoxFont) \
      -selectbackground $glob(gui,color_select_bg) \
      -selectforeground $glob(gui,color_select_fg) \
      -background $glob(gui,color_bg) \
      -foreground $glob(gui,color_fg) \
      -highlightthickness 1 
  lappend glob(winlist,color_xx) $glob(win,$inst).entry_dir


  label $wft.stat -text ""\
      -justify center\
      -bd 0\
      -relief raised\
      -font $glob(gui,ListBoxFont)
  # The tree entry is first (if unix) and is put here
  # by buildTree.
  # grid $wf.dir_but     -row 1 -sticky ew -column 0
  grid $wf.hotlist_but -row 1 -sticky e -column 1
  grid $wf.history_but -row 1 -sticky e -column 2
  grid $wf.etc_but     -row 1 -sticky e -column 3
  grid $wf.button_parentdir -row 1 -sticky ew -column 10
  
  grid columnconfigure $wf all -weight 1
  grid columnconfigure $wf $wf.button_parentdir \
      -weight 1000 -uniform 0 -minsize 16

  grid $wf  -row 1 -sticky ew
  grid $wft -row 2 -sticky ew
  grid $glob(win,$inst).entry_dir -row 3 -sticky ew
  # row 4 is the listbox...
  grid columnconfigure $glob(win,$inst) all -weight 1
  grid rowconfigure    $glob(win,$inst) 10  -weight 1
  

  grid $wft.button_back   -row 1 -column 0 -sticky ew
  grid $wft.button_update -row 1 -column 2 -sticky ew
  grid $wft.stat          -row 1 -column 3 -sticky ew
  grid $wft.button_frterm -row 1 -column 4 -sticky ew
  grid $wft.button_xterm  -row 1 -column 5 -sticky ew

  grid columnconfigure $wft $wft.stat -weight 1
  
#  pack $glob(win,$inst).frame_listb -side top -fill both -expand 1
#  we do the build from the config file read...
#  buildListBox $inst
}

proc BuildListBoxes {} {
  global glob config
  # prevent trying to update while rebuilding
  set glob(panelsLocked) 1
  ToggleCollock
  buildListBox left
  buildListBox right
  set glob(panelsLocked) \
      [expr {$config(ListBoxColumns,left) != $config(ListBoxColumns,right)}]
  ToggleCollock
  # ReconfigFont wants to mess with listbox fonts so the listboxes must exist first
  ReConfigColors foo
  ReConfigFont

  foreach men $glob(userMenuList) {
    destroy $men
  }
  set glob(userMenuList) {}
  set glob(menus,left) {}
  set glob(menus,right) {}

  foreach {add ref} [concat [array get config "bind"]\
			 [array get config "global-bind,*"]] {
    if {![string match "DoMenu,*" $ref]} {continue}

    lassign [split $ref ","] junk name
    if {![info exists config(menu,$name)]} {
      PopError \
	  [_ "Config error: config($add) refers to a menu ( config(menu,$name) )\
             \n that does not exist. Binding $add will throw error."]
      continue
    }
    # Build the user menu...
    foreach inst {left right} {
      if {[lsearch -exact $glob(userMenuList) \
	       "$glob(listbox,$inst).file.$name"] == -1} {
	lappend glob(menus,$inst) \
	    [buildMenu $name $glob(listbox,$inst).file $inst $config(menu,$name)]
      }
    }
  }
  # Here we look up the bindings for each of the configured buttons**************bug
  # foreach {but val} [array get config "bind"] { ;(should be "bind*" but not used)
  #   foreach inst {left right} {
  #     set glob($but,$inst) [findCommand $val $inst]
  #   }
  # }
}

proc buildMenu {name w inst val} {
  global glob config 
  menu $w.$name \
      -tearoffcommand FixTearoff \
      -title $name \
      -tearoff true 
  # -font $glob(gui,GuiFont)
  foreach it $val {
    lassign $it itm actual
    set actual [expr {$actual == {} ? $itm : $actual }]
    switch -glob $itm {
      {} { $w.$name add separator}
      menu,* {
	set cname [regsub {[^,]*,(.*)} $itm {\1}]
	if {![info exists config(menu,$cname)]} {
	  PopError "menu $cname refered to by menu $name does not exist. \
                  \nSkiping cascade menu."
	} else {
	  if {[string match "*.$cname.*" $w.$name]} {
	    PopError "menu '$name' makes a recursive reference to menu '$cname'. \
                  \nSkiping cascade menu."
	  } else {
	    $w.$name add cascade -menu $w.$name.$cname -label $cname
	    buildMenu $cname $w.$name $inst $config(menu,$cname)
	  }
	}
      } 
      default {
	set cmd "[findCommand [lindex $actual 0] $inst] [lrange $actual 1 end]"
	$w.$name add command -label $itm \
	    -command "DoMenu [list $cmd $inst] "
	foreach entry $config(middle_button_colors) {
	  lassign $entry thename color
	  if {$thename == $actual} {
	    switch -glob $color {
	      -* {$w.$name entryconfigure end -activebackground \
		      [string range $color 1 end]}
	      default {$w.$name entryconfigure end -background $color}
	    }
	  }
	}
      }
    }
  }
  lappend glob(userMenuList) "$w.$name"
  return [list DoMenu,$name [list [list tk_popup  $w.$name %X %Y]]]
}

# Looks up commands that may be object of config(bind,*)
# returns proc calling sequence & if not for dir listin pane
# the target window.

proc findCommand {name inst} {
  global glob
  foreach ent [concat $glob(buttoncmds) \
		   $glob(middlebuttoncmds) \
		   $glob(menus,$inst)] {
    lassign $ent nam cmd -> w
    #
    # frputs w ent
    if {$nam == $name} {return [list $cmd {*}$w ]}
  }
  #error "command $name not found"
  return [list $name]
}
#
# Give 'this' a string containing either 'left' or 'right' return the 
# same string with 'left' replaced by 'right' and 'right' replaced by 'left'
#
proc OpName {this} {
  return [string map {left right right left} $this]
}
# Create listbox ==========================================================
set ::inPane {}

proc buildListBox {inst} {
  global glob config
  destroy $glob(win,$inst).frame_listb
  # frputs #2 #3
  startProc "Begin BuildListBox $inst"
  frame $glob(win,$inst).frame_listb -bd 0
                            

  set lbw [multilist $glob(win,$inst).frame_listb config(ListBoxColumns,$inst) \
	       -toptions [list  -relief {ridge} \
			      -bd 0]\
 	       -loptions [list  -relief {ridge} \
			      -selectmode extended] \
	       -boptions [list {*}[getImage -bitmap toggle\
				       @$glob(lib_fr)/bitmaps/toggle.bit] \
			      -command "ToggleSelect $inst" \
			      -bd 1 -height 12]\
               -font $glob(gui,ListBoxFont) \
	       -selectscript "ListBoxSelected" \
	       -listcolumnscroll $config(columnScroll) \
	       -soptions "-width $config(columnScrollSize)"\
	   ]
  set glob(listbox,$inst) $lbw
  #  puts "window name is $lbw"
  foreach lbentry $config(ListBoxColumns,$inst) {
    set swinn [lindex $lbentry 0]
    $lbw.$swinn config -listvariable glob($inst,lv$swinn)
  }
  set newcolorlist {}
  foreach entry $glob(winlist,color_xx) {
    if {[string match "$lbw.*" $entry] } continue
    lappend newcolorlist $entry 
  }
  set glob(winlist,color_xx) $newcolorlist
  grid $glob(win,$inst).frame_listb -row 10 -sticky news
  if {[trace info variable  config(ListBoxColumns,$inst)] == {}} {
    trace add variable config(ListBoxColumns,$inst) write \
	"after idle [list TraceColTo $inst [Opposite $inst]]"
  }
  startProc "End BuildListBox $inst"
}

#================ end of mulist listbox set up ========================

# This function seems not to be called and is likely why paste doesn't do
# what we would like.... in X, works in Windows...

proc GetFileListBoxSTRING_Selection {offset maxBytes } {
  global glob
  set l {}
#  puts "building selection responce"
  foreach inst {left right} {
    foreach sel [$glob(listbox,$inst).file curselection] {
      set l "$l $glob($inst,pwd)/[lindex [lindex $glob($inst,filelist) $sel] 1]"
    }
  }
#  puts "$l"
  return [string range $l 1 $maxBytes]
}

# called from the ^ button...
proc UpDirTree { inst x y} {
#  Log "$x $y $inst $w"
  global glob
  set priordir $glob($inst,pwd)
  DoProtCmd "NewPwd $inst [list $priordir/..] \;
             UpdateWindow $inst"
  # The intent here is to put a volume list in the hot list for Windows
  # which treats each volume as a totally separate thing...
  # Only do this if s/he is trying to go up from the root of the tree...
  if {$priordir == $glob($inst,pwd) } {
    # We add 10 so the mouse is not in the menu (causes the up event to 
    # close the menu)
    $glob(win,$inst).dirmenu_frame.hotlist_but.m post [expr {$x + 10}] $y
  }
  return
}

proc wLinkName {inst fileEnt} {
  global glob
  lassign $fileEnt {*}$glob(fListEl)
  switch -glob $type {
    *l* {
      return  $link
    }
  }
  return {}
}

proc FTPDateStringToSeconds { date } {
  set r [catch {clock scan "$date"} out]
  if {!$r} {
    # Had to add heuristics here to get the correct year since it 
    # doesn't say which year in the input string
    set today [clock seconds]
    # If the date looks like it's more than two months in the future,
    # let's subtract a year...
    if {$out > ($today+5184000)} {
      set t [clock format $out]
      set y [lindex $t end]
      incr y -1
      set t "[lrange $t 0 [expr [llength $t]-3]] $y"
      set r [catch {clock scan $t} out2]
      if {!$r} {
        set out $out2
      }
    }
    return $out
  }
  set r [catch {clock scan \
		    "[lindex $date 1] [lindex $date 0] [lindex $date 2]"} out]
  if {$r} {return 0}
  return "$out"
}

proc UpdateWindow { inst } {
  global glob
  if {$glob(async) == "-a"} return

  if {$glob(left,pwd) == $glob(right,pwd)} {
    set inst "both"
  }
  switch $inst {
    left  { UpdateWindow_ left 0  }
    right { UpdateWindow_ right 0 }
    both  { UpdateWindow_ left 0 
            if {$glob(left,pwd) == $glob(right,pwd)} {
              UpdateWindow_ right 1 
            } else {
              UpdateWindow_ right 0 
            }
          }
  }
  UpdateStat
}

# UpdateIf takes zero or more file name(s)  and updates if it  is
# in one of the panel displays
proc UpdateIf {args} {
  global glob
  set done {}
  set doneDir {}
  frputs args
  foreach file $args {
    frputs #2 args
    set dir [URL norm $file/..]
    if {$dir in $doneDir} {continue}
    lappend doneDir $dir
    if {[IsVFS $dir]} {
      ::VFSvars::VFS_InvalidateCache $dir
    }
    frputs dir
    foreach inst {left right} {
      if {$inst ni $done && $dir == $glob($inst,pwd)} {
	ForceUpdate $inst
	lappend done $inst
      }
    }
  }
}

proc ForceUpdate {{inst  both}} {
  global glob
  set glob(forceupdate) 1
  UpdateWindow $inst
  set glob(forceupdate) 0
}

proc UpdateWindow_ { inst quick } {
  global glob config

  # clear the select history
  if {$inst == $glob(select_pry_lr)} {
    highlightOff
  }
  if {$inst == $glob(select_cur_lr)} {
    set glob(select_cur_lr) {}
  }

  # Up date the free bytes on the device...
  # if {[IsVFS $glob($inst,pwd)]} {
  #   set glob($inst,df) ?
  # }
  
  # entry_dir is the contents of the dir box at the head of the dir window
  # If ftp and not a forced update and old==new, just update entry_dir
  if { [IsVFS $glob(${inst},pwd)] && (!$glob(forceupdate)) } {
    if {$glob(${inst},update_oldpwd) == $glob(${inst},pwd)} {
      setDisplayDir $inst
      return ""
    }
  }
  set Other [Opposite $inst]
  # next line for autoupdater 
  # (quick => left==right this is right and just did left or visa versa)
  if {$quick} {
    set glob($inst,lastmtime) $glob($Other,lastmtime)
    set oldy [lindex [$glob(listbox,$Other).file yview] 0]
  } else {
    catch {set glob($inst,lastmtime) [file mtime $glob($inst,pwd)]}
    set oldy [lindex [$glob(listbox,$inst).file yview] 0]
  }

  set oldlist $glob(${inst},filelist)
  # use other window if it is the same and current...
  if {$quick} {
    set r 0
    set glob(${inst},filelist) $glob($Other,filelist)
    set glob($inst,df) $glob($Other,df)
  } else {
    if {[IsVFS $glob($inst,pwd)] && $glob(forceupdate) } {
      ::VFSvars::VFS_InvalidateCache $glob($inst,pwd)
    }
    while {[set r [catch {GetDirList $inst} glob(${inst},filelist)]] != 0} {
      # Failure to read a dir. Lets just go up the tree and try again.
      frputs glob(${inst},filelist) ::errorInfo
      set glob($inst,dirstack) [lrange $glob($inst,dirstack) 1 end]
      NewPwd $inst $glob($inst,pwd)/.. goUp
    }
  }
  setDisplayDir $inst

  # if old list is same as new and not forced... over and out.
  if {$oldlist == $glob(${inst},filelist) && (!$glob(forceupdate))} {
    set glob(${inst},update_oldpwd) $glob(${inst},pwd)
    return
  }
  # populate the list box
  if {$quick} {
    foreach flist $glob(listboxNames) {
      set glob($inst,lv$flist) $glob($Other,lv$flist)
    }
  } else {
    set start [clock mill]
    ConstructFileList $inst
    set DisTime [expr {[clock mill] - $start}]
    frputs DisTime
  }
  # Here is where we position the text in the window....
  # Not completly sure why we need the update, but if we don't the
  # yview moveto will not work correctly.
  update idletasks
  if {$glob(${inst},update_oldpwd) == $glob(${inst},pwd)} {
# How do we do this now?
    $glob(listbox,$inst).file yview moveto $oldy
  } else {
    # frputs glob($inst,dirstack)
    set idx \
	[lsearch -index 0 -exact -start 1 $glob($inst,dirstack) $glob(${inst},pwd)]
    if {$idx != -1} {
      set index [lindex $glob($inst,dirstack) $idx 1]
      $glob(listbox,$inst).file activate $index
      $glob(listbox,$inst).file see $index
      if {[$glob(listbox,$Other).file curselection] == {}} {	
	$glob(listbox,$inst).file selection set $index
	propagateSelection $glob(listbox,$inst).file
      }
    }
    # if {[lindex $glob($inst,dirstack) 1 0] == $glob(${inst},pwd) } {
    # }
  }
  set glob(${inst},update_oldpwd) $glob(${inst},pwd)
}

##################################: DisplayName code #####################
# We want this to be a two way street, dir -> dir with embeded display name
# and "display name" -> dir
# The first conversion should be fast while we don't want to slouch much
# on the the 2ed.
# For the first, since we will often get results that start with a DN and
# finish with a sub dir AND will have cases where the sub dir may also
# have a DN, we will set up a list of doublets {dir DN} and insure that
# the longest dirs are befor shorter ones. This also allows us to use
# the "string map" code to do the conversion. Using "string map" eliminates
# all the partial string work..
# To go the other way (DN to dir) we will just use the array notation.
#
# So, we mantain two reps, the list of doublets and the array.
# To keep every thing straight we do all the list/array stuff here.
#
# We have 4 routines:
#
# 1)   addDN list     {may add more than one, dublets, {dir name}}
#                     dir must be absolute and name unique
#                     error checking to insure absolute path and unique
# 1.1) addDNtoList    {No error checking, sorts on path length}
# 2)   delDN name     {only one at a time}
# 3)   dirToDN dir    {returns the dir with a DN inserted if needed}
# 3.1) dirToDNexact dir {only exact match returned. For building dir list
# 4)   DNtoDir     nam  {returns the dir with any DN expanded}
# 5)   DNtoDirtail nam  {returns dir using only the the tail, used by cmds}
# 6)   delDNpat    pat  (deletes display name that matches 'pat' fails if not
#                        exactly 1 match. Returns number of matches.)
# 7)   delDNdir    dir  (deletes all display names for dir)

# set  DNlist {}

# On CASE,      Display names have case, MSW Dirs do not! Nuf said!

# On collision, if the dir already has a DN, we want to redefine it.
#               if the DN is already used, we want to throw an error
# In addition,  if the dir is not nil or absolute, throw an error.
# Mark our errors with "-" as first char. so they can be identified.


proc addDN {newDN} {
  global DNlist DNtoDir DirToDN
  # frputs #2 #1 newDN
  foreach {dir name} $newDN {
    # To avoid confusion we change the / and \ characters
    # to other UTF-8 chars that look the same (well really close)
    set name [regsub -all {/}  $name $::optionalSlash]
    set name [regsub -all {\\} $name $::optionalBackSlash]
    set oldName [dirToDNexact $dir]
    # if exact, its a dup, just skip
    # frputs oldName name
    if {$oldName == $name} {continue}
    # if the difference is only case and MSW, skip other tests
    if {[info exists DNtoDir($name)] ||\
	    $dir != {} && ![IsVFS $dir] &&\
	    (($::MSW && ![regexp -nocase {^([a-z]:|//)} $dir]) ||\
		 (!$::MSW && [string index $dir 0] != "/"))} {
      set ms [_ "\"%s\" not an absolute path or \"%s\" already exists" $dir $name]
      return -code error "- $ms"
    }
    # Volume names must have trailing /
    # if {$::MSW && [string match -nocase {[a-z]:} $dir]} {
    #   set dir $dir/
    # }
    if {$::MSW && [string match -nocase {[a-z]:/} $dir]} {
      set dir [string range $dir 0 end-1]
    }
    if {$oldName != {}} {
      delDN $oldName
    }
    addDNtoList [list $dir $name]
  }
}

# addDNtoList is called to add new entries and also to
# resort the list after a delete
# We could mess with case issues in the compare but it
# makes no real difference as the length is most important.

# THIS ROUTINE ASSUMES ERROR CHECKING HAS ALREADY BEEN DONE

proc addDNtoList {newDN} {
  global DNlist DNtoDir DirToDN
  set DNlist [concat $DNlist $newDN]
  set nl {}
  foreach {dir name} $DNlist {
    lappend nl [list $dir $name]
  }
  # frputs #3 #2 #1 nl 
  set nl [lsort -command {apply {{a b} {
    expr {[set l [expr {[string length $b] -\
			    [string length $a]}]] != 0 ? $l :\
 	      [string compare $b $a]}}}} \
	      -index 0 -unique $nl]
  set DNlist {}
  # frputs nl
  foreach nle $nl {
    lappend DNlist {*}$nle
  }
  # frputs nl DNlist
  array unset  DirToDN
  array unset  DNtoDir
  array set DNtoDir [lreverse $DNlist]
  array set DirToDN $DNlist
}
# delete by pattern. Returns number of matches. Fails if any but 1 match.
proc delDNpat {pat} {
  global DNlist
  set pat [regsub -all {/}  $pat $::optionalSlash]
  set pat [regsub -all {\\} $pat $::optionalBackSlash]
  set match 0
  foreach {dir name} $DNlist {
    if {[string match $pat $name]} {
      set pos $name
      incr match
    }
  }
  if {$match == 1} {
    delDN $pos
  }
  return $match
}
# delete all DNs for dir
proc delDNdir {dirin} {
  global DNlist
  foreach {dir name} $DNlist {
    if {$dir == $dirin} {
      lappend dirlist $name
    }
    foreach nam $name {
      delDN $name
    }
  }
}
# given a DN delete that entry
proc delDN {name} {
  global DNlist DNtoDir
  set name [regsub -all {/}  $name $::optionalSlash]
  set name [regsub -all {\\} $name $::optionalBackSlash]
  # I suppose this could be faster, but we don't expect to do this often
  unset -nocomplain DNtoDir($name)
  set DNlist {}
  # This depends on a full sort as well as the -unique...
  addDNtoList [lreverse [array get DNtoDir]]
}

# This version is exact only
# case issues here!
# given directory return DN exact
proc dirToDNexact {name} {
  global DirToDN
  set name [regsub -all {/}  $name $::optionalSlash]
  set name [regsub -all {\\} $name $::optionalBackSlash]
  if {[info exist DirToDN($name)]} {
    return $DirToDN($name)
  } else {
    return {}
  }
}

# Case issues here
proc dirToDN {name} {
  global DNlist
  # set opt [expr {$::MSW ? "-nocase" : ""}]
  set ln [string length $name]
  if {$ln == 0} {
    if {[lindex $DNlist end-1] == {}} {
      return [lindex $DNlist end]
    } else {
      return $name
    }
  }
  # The DNlist is a sorted dict list with the longest directorys
  # first. Thus if both /foo and /foo/bar are in the list we
  # will find /foo/bar. So we will do a search in a foreach...
  foreach {dir Dname} $DNlist {
    if {[set lt [string length $dir]] == 0} {
      break
    }
    # frputs lt dir Dname ln
    if {$lt <= $ln && [string equal {*}$::CASEops -length $lt $dir $name]} {
      # This is either it or it does not exist in our list
      if {[string index $name $lt] in {/ {}}} {
	return $Dname[string range $name $lt end]
      }
      break
    }
  }
  return $name
}

# In the below, any part of 'name' that is a display name
# has case.

proc DNtoDir {name} {
  global DNtoDir
  # again, we could mess arround with a string map, but...
  # that would require a new sort as well.
  # Here we take advantage of the fact that a DN must be the
  # first thing in a dir. We also have //sys to worry about.
  set idx [string first "/" $name]
  if {[string index $name $idx+1] == "/"} {
    set idx [string first "/" $name $idx+2]
  }
  incr idx -1
  if {$idx < 0} {
    set idx "end"
  }
 # frputs idx
  set fname [string range $name 0 $idx]
  if {[info exists DNtoDir($fname)]} {
    return $DNtoDir($fname)[string range $name $idx+1 end]
  } else {
    return $name
  }
}
#
# And this is for when we want to pull a name out of a dir list...
# We should have the full path/name and will return that if
# there is no DN, otherwise the Dir.
# We have a context issue here. If we find an entry for the tail
# we need to also insure that the rest of the path matches otherwise
# we will treating normal dir names as display names and going off
# to never never land...

proc DNtoDirTail {name} {
  global DNtoDir
  set tail [file tail $name]
  if {[info exist DNtoDir($tail)]} {
    set pos $DNtoDir($tail)
    if {[file dirname $name] in [list . [file dirname $pos]]} {
      return $pos
    }
  }
  return $name
}
###############################: End of display name code ################

proc setDisplayDir {inst} {
  global glob
  $glob(win,$inst).entry_dir delete 0 end
  $glob(win,$inst).entry_dir insert end [dirToDN $glob(${inst},pwd)]
  $glob(win,$inst).entry_dir xview end
  $glob(win,$inst).entry_dir xview scroll 1 unit
  set glob(whichdir) $inst
}

proc GotoNewDir { inst { ask 0 } } {
  global glob
  if { ! $ask } {
    set newdir [DNtoDir [$glob(win,$inst).entry_dir get]]
  } else {
    # this takes us to the volume dir.
    set newdir ""
  }
  DoProtCmd { 
    NewPwd  ${inst} $newdir
    UpdateWindow ${inst}
  }
  focus .
}

# TruncateGotoNewDir is called on <Double-1> on the entry_dir
# <Double-1> selects the 'word' under the mouse.
# We use that section to eliminate dirs to the right in the entry
# and then go to the remaining directory

proc TruncateGotoNewDir {w inst x} {
  global glob
  set end [$w index end]
  set sel [$w index @$x]
  set dir [$w get]
  if {[IsVFS $dir]} {
    set sel [expr {max [string length $VFStok], $sel}]
  }
  $w selection clear
  while {[string index $dir $sel] != "/" && [incr sel] <= $end} {}
  if {$sel-1 < $end} {
    DoProtCmd { 
      NewPwd  ${inst} [DNtoDir [string range $dir 0 $sel-1]]
      UpdateWindow ${inst}
    }
    focus .
  }
}

proc SelectThis {inst sel} {
  global glob
  if {$sel == {}} {return}
  foreach select $sel {
    $glob(listbox,$inst).file selection set $select
  }
  propagateSelection $glob(listbox,$inst).file
  UpdateStat_ $inst
}
# Here when a list box selection changes sel is a list of entries currently
# selected (may be empty).
#
proc ListBoxSelected { w sel} {
  global glob
#  puts "listboxselect $w $sel"
  if { $sel == "" } return
  if {$w != $glob(listbox,left)} {
    set inst right
    set other  $glob(listbox,left)
  } else {
    set inst left
    set other $glob(listbox,right)
  }
  set glob(selected) $inst
  $other.file selection clear 0 end
  propagateSelection $other.file
  set glob(selectFileList) {}
  foreach selent $sel {
    lappend glob(selectFileList) \
	$glob($inst,pwd)/[lindex $glob($inst,filelist) $selent 1]
  }
  # Make the selection available to the window system
  $glob(selectWindow) selection set 0 end
  # Arange to have the window system tell us when it is lost
  selection own -command "TextBoxSelect $w" $glob(selectWindow)
  # We catch this because it fails if we are in a VFS dir.
  catch [list cd $glob($inst,pwd)]
  UpdateStat
}
# We come here when ever we loose the selection.
proc TextBoxSelect {w } {
#  puts "TextBoxSelect $w"
  global glob
  $w.file selection clear 0 end
  propagateSelection $w.file
  highlightOff
  set glob(select_cur_lr) {}
}
proc ToggleSelectEntry { inst y } {
  global glob
#  puts "ToggleSelectEntry $inst $y"
  set index [$glob(listbox,$inst).file nearest $y]
  if {[$glob(listbox,$inst).file selection includes $index]} {
    $glob(listbox,$inst).file selection clear $index
    set glob(listbox,last) clear
    set glob(listbox,last,idx) $index
  } else {
    $glob(listbox,$inst).file selection set $index
    set glob(listbox,last) set
    set glob(listbox,last,idx) $index
  }
  propagateSelection $glob(listbox,$inst).file
}

proc ToggleSelectEntryMotion { inst y } {
  global glob
  # For some reason, sometimes the ToggleSelectEntry function 
  # does not get called before this....
  if {[info exists glob(listbox,last)]} {
    set index [$glob(listbox,$inst).file nearest $y]
    $glob(listbox,$inst).file selection \
	$glob(listbox,last) $glob(listbox,last,idx) $index 
    propagateSelection $glob(listbox,$inst).file
  }
}

# Here we set up the required/requested bindings from config(bind,*)
# Here is what we learned while working with this.
# 1.) every Button also has a Button-release
# 2.) any modifier 'key' used with the button may be released prior to the
#     Button-release.
# 3.) These Button-release events may have meaning (i.e. bindings) at
#     a more global level (e.g. Button-release-2 may be 'paste')
# We attempt to avoid (or rather absorb) this shrapnel here.

# a helper proc

proc release {w this} {
  set old [bind $w <$this>]
  set old [string range $old [string first \; $old]+1 end]
  # frputs this w "[bind $w <$this>] " old
  bind $w <$this> $old
  bind $w <ButtonRelease-$this> {}
}
   
proc doBind {w event cmd {inst glob}} {
  set modifiers {
    Control Alt Shift Lock Extended Button1 B1 
    Button2 Button3 B3 Button4 B4 Button5 B5
    Mod1 M1 Command Mod2 M2 Option Mod3 M3 
    Mod4 M4 Mod5 M5 Meta M
  }

  set eventParts [split $event -]
  # If we have a button number and it is not alone, we need to
  # avoid the release of both the button and the combined modifier-button
  
  set shrapnel 0
  if {[regexp {(^|-)(1|2|3)(-|$)} $event -> -> but]} {
    foreach part $eventParts {
      if {$part in {"ButtonPress" "Button"}} {continue}
      if {$part == "ButtonRelease"} {
        # don't know how to handle these
        set shrapnel 0
        break
      }
      if {$part == $but} {
        lappend negEvent "ButtonRelease"
      }
      if {$part in $modifiers} {incr shrapnel}

      lappend negEvent $part
    }
  }
  catch {bind $w <$event> {} }
  
  # here we set up the shrapnel avoidance
  if {$shrapnel != 0} {
    set cmd "bind %W <ButtonRelease-%b> {release %W %b;break}
             bind %W <$but> \"break\;\[bind %W <%b>]\"
             $cmd
             break"
    bind $w <[join $negEvent -]> "release %W %b;break"
  }
  if {[catch {bind $w <$event> $cmd}  out] != 0 } {
    if {$inst in {"left" "glob"} } {
      # only complain about this on one of the panes
      lappend err  [list $event $w $out]
    }
  }
  return {}
}        
   
# The 'InitBindings' code takes care of standard bindings for each display
# pane (including the dir entry) and for all config(bind,*) and
# config(global-bind,*) entries.
#

proc InitBindings {} {
  global config glob

  # First the entry_dir
  set glb 0
  set done {}
  foreach inst {left right} {
    set pane $glob(win,$inst)
    bind $pane.entry_dir <Key>      "set glob(whichdir) $inst"
    bind $pane.entry_dir <Return>   "GotoNewDir $inst;break"
    bind $pane.entry_dir <KP_Enter> "GotoNewDir $inst;break"
    bind $pane.entry_dir <3>        "GotoNewDir $inst 1;break" 
    bind $pane.entry_dir <<Paste>>  "Do_Paste_dir $inst"
    bind $pane.entry_dir <<PasteSelection>>  "Do_Paste_dir $inst"
    bind $pane.entry_dir <Escape>   "\ 
                                           DoProtCmd \"UpdateWindow ${inst}\"
                                           focus ."
    bind $pane.entry_dir <Double-1> "TruncateGotoNewDir %W $inst %x;break"
    
    bindtags $pane.entry_dir "$pane.entry_dir Entry . all"
  
    # now the list boxes...
    foreach winn $config(ListBoxColumns,$inst) {
      set swin [lindex $winn 0]
      set lbw $glob(listbox,$inst)
      set wd $lbw.$swin
      lappend glob(winlist,color_xx) $wd $lbw.label$swin

      # Bind the buttons for directory panes
      
      bind $wd <Tab> "focus [OpName $wd];break"
      bind $wd <MouseWheel> "$wd yview scroll\
             \[expr {%D > 0 ? -$config(mwheel,delta) : $config(mwheel,delta)}] units
             break"
      bind $wd $config(mwheel,neg) "$wd yview scroll -$config(mwheel,delta) units
                                  break"

      bind $wd $config(mwheel,pos) "$wd yview scroll $config(mwheel,delta) units
                                  break"
      bind $wd <2> "ToggleSelectEntry ${inst} %y;break"
      bind $wd <B2-Motion> "ToggleSelectEntryMotion ${inst} %y;break"

      # config driven bindings.
      # binding references in the 'config' array are translated into
      # bind statements using glob(buttoncmds), glob(middlebuttoncmds)
      # and glob(menus,$inst). The first two of these have sublist:
      # 'nice name' 'command' 'information text' 'window'
      # If 'window' is nil it is bound to each dir list display, unless
      # it comes from the config(global-bind,*) in which case it is bound
      # to '.'. The other binding used (at this time) is to the Dir entry
      # window (which has both left & right). We do this only once for each
      # pane by keeping a list of windows already bound.
      
      foreach {even val} [concat [array get config "bind*"]\
                              {-> EVAL}\
                              [array get config "global-bind,*"]] {
        if {$val == {}} {continue}
        if {$val == "EVAL"} {
          if {[incr glb] >= 2} {break}
          
          continue
        }
        # get more info...
        if {[set ent [lsearch -exact -index 0 -inline\
                          $glob(buttoncmds) $val]] != {}} {
          lassign $ent -> cmd -> win
          if {$win != {}} {
            set win [subst $win]
            # frputs win cmd done
            if {"$win-$cmd" in $done} {continue}
            lappend done "$win-$cmd"
          }
        } elseif {[set ent [lsearch -exact -index 0 -inline\
                                $glob(middlebuttoncmds) $val]] != {} ||\
                      [set ent [lsearch -exact -index 0 -inline\
                                    $glob(menus,$inst) $val]] != {} ||\
                      [set ent "{} $val"] != {}} {
          set cmd [lindex $ent 1]
          set win $wd
        }
        set win [expr {$win == {} ? $wd : $win}]
        lassign [split $even ,.] -> event
        if {[llength $cmd] > 1} {
          set cmd "[subst $cmd]
                   break"
        } else {
          set cmd "DoBut $cmd $inst \[$win nearest %y\] %X %Y
                 break"
        }
        if {$glb == 1} {
          # frputs event cmd
          set win .
        }
        # frputs win event cmd inst
        lappend err [doBind $win $event $cmd $inst]
      }
      incr glb
      #bind $wd <ButtonRelease-1> "+UpdateStat"
      #bind $wd <ButtonRelease-2> "+UpdateStat"
      set tmp "Alt-"
      #bind $wd <Any-1>  "+focus $wd"
      bind $wd <Escape> "focus ."
      bind $wd <Left> "DoProtCmd \" 
          NewPwd $inst \\\$glob(${inst},pwd)/..
          UpdateWindow $inst\"
          catch \"focus $wd\"
          break
        "
      bind $wd <Right> "
          DoProtCmd CmdView
          catch \"focus $wd\"
           break
        "
      # Alt-Key always, simple key eliminates the showlist.
      
      bind $wd <Alt-Key> "frputs KP %A;DoCommandOnKey $inst %A"
      bind $wd <Alt-Double-KeyRelease> {frputs "InitBindings ";InitBindings}
      
      if {$config(keyb_support)} {
	bind $wd <KeyPress>  "frputs KP %A;DoCommandOnKey $inst %A"
	set subWin ".dirmenu_frame"
      } else {
	set subWin {}
      }
    }
    # We want the Keys no matter where the focus is...
    bind .   <Key> {ShowListOnKey $::inPane %A %W}
    bind .   <Control-Key> {ShowListOnKey $::inPane %A %W c}
    bind .   <Shift-Control-Key> {ShowListOnKey $::inPane %A %W cs}
    
    bind $pane <Enter> "set ::inPane $inst"
    bind $pane <Leave> "set ::inPane {}"
    bind $pane <Escape> break

    bind $pane.frame_listb <Leave>  {}
    bind $pane.frame_listb <Escape> {}
    
    if {$config(keyb_support)} {
      bind $pane.frame_listb <Enter> "set ::inPane {}" 
      bind $pane.frame_listb <Leave> "set ::inPane $inst"
      bind $pane.frame_listb <Escape> break
    }      
    
  }
  # grid $pane.frame_listb -row 10 -sticky news
  if {[info exists err]} {
    set errlist [lsort -unique $err]
    foreach ent $errlist {
      if {$ent == {}} {continue}
      lassign $ent event w out
      # puts "$ent $button $out"
      PopError [_ "In trying to bind '%s' in window %s \
                \nerror '%s' occured. \
                 \n Skipping this binding." $event $w $out]
    }
  }

}

# The get_Pasted command makes every attempt to decode a paste and return
# the "expected" result. While "selection" says it is for X11 it seems to work
# for MSW as well... We prefer UTF8 and CLIPBOARD

proc get_Pasted {{sel PRIMARY}} {
  foreach typ {UTF8_STRING STRING} {
    if {![catch {selection get -selection $sel -type $typ} select]} {
      frputs #2 select sel
      return $select
    }
  }
  return {}
}  

proc Do_Paste_dir { inst {t PRIMARY}} {
  global glob
  set dir "[get_Pasted $t]"
  # Do a normal paste if not a file (or not one we can look at)
  # take care of embeded newlines using only the first one
  set dir [lindex [split $dir \n] 0]
  if {![IsVFS $dir] && ![file exists $dir]} {return}
  frputs dir
  set ndir $dir
  if  {![file isdirectory $ndir] &&\
	   [catch {LnkFile $ndir} dir] != 0 &&\
	   $ndir != $dir} {
    frputs dir ndir
    return} 
  if {![file exists $dir]} {return}
  frputs dir
  # if it is a link, get that...
  set dir [URL dir [URL norm $dir/x]]
  DoProtCmd {
    GotoFind [URL dir $dir] [file tail $dir] $inst
  }
  return -code break
}

proc DoCommandOnKey { inst key } {
  global glob
  if {$key == ""} return
  if {$key == "\r"} {
    DoProtCmd "CmdView"
    catch {focus $glob(listbox,$inst).dir}
    return
  }
  foreach k $glob(cmds,list) {
    if {$key == [lindex $k 2]} {
      DoProtCmd "[lindex $k 1]"
      catch {focus $glob(listbox,$inst).dir}
      return
    }
  }
  LogStatusOnly [_ "Cannot recognize keyboard shortcut %s" $key]
}

proc UpdateStat { } {
  global glob
    if {! ([UpdateStat_ left] | [UpdateStat_ right]) } {
      set glob(select_cur_lr) {}
    }
}

proc twidleHighlight { inst onoff items } {
  global glob config
  if {$onoff == "off" } {
    set way "-bg {} -fg {}"
  } else {
    set way "-bg $glob(gui,color_highlight_bg)\
             -fg $glob(gui,color_highlight_fg)"
  }
  foreachButListbox $glob(listbox,$inst) \
      "\{ foreach ind \{$items\} {
           \$wc.\$win itemconfigure \$ind $way \
	     }\}" \
	".-"
}

proc highlightOff {} {
  global glob
  if {[info exists glob(select_pry_lr)] && $glob(select_pry_lr) != {}} {
    twidleHighlight $glob(select_pry_lr) off $glob(select_pry_s)
  }
  set glob(select_pry_lr) {}
}

proc UpdateStat_ { inst } {
  global glob config
  set oldena $glob(enableautoupdate)
  if {$oldena != 0 } {
    set glob(enableautoupdate) 0
  }

  # We want to keep track of the last selection (which we call pry for prior).
  # this is used in the diff command.  Want to add highlight......................
  # suffix 'lr' == left right
  # suffix 's'  == selection
  set extending 0
  set select [$glob(listbox,$inst).file curselection]
  if {$inst == $glob(select_cur_lr) } {
    foreach s  $select {
    # extending the selection..?
      if {$s in $glob(select_cur_s)} {
	set glob(select_cur_s) $select
	# if { $glob(enableautoupdate) != $oldena} {
	#   set glob(enableautoupdate) $oldena
	# }
	set extending 1
	break
      }
    }
  }
  if {[llength $select] && ! $extending} {
 #   puts "found selection $inst"
    if { $inst != $glob(select_cur_lr) || 
	 $select != $glob(select_cur_s)} {
      # Remove old highlight it any
      if {$glob(select_pry_lr) != {}} {
	twidleHighlight $glob(select_pry_lr) off $glob(select_pry_s) 
      }
      
      if {$glob(select_cur_lr) != {} } {
	twidleHighlight $glob(select_cur_lr) on $glob(select_cur_s) 
      }
      
      set glob(select_pry_lr) $glob(select_cur_lr)
      set glob(select_pry_s) $glob(select_cur_s)
      set glob(select_cur_lr) $inst
      set glob(select_cur_s) $select
      # Here we set up and display the first selected file
      # and all it bits ...
      set indx [lindex $select 0]
      set disp {}
      foreach lbentry $config(ListBoxColumns,$inst) {
	set flist [lindex $lbentry 0]
	set disp "$disp [lindex $glob($inst,lv$flist) $indx]"
      }
      LogStatusOnly $disp
    }
  }
  # sum the sizes of the selected files (depends on size being #3)
  set n 0
  set s 0
  foreach k $select {
    set e [lindex $glob($inst,filelist) $k 3]
    if {[string is digit -strict $e]} {
      incr s $e
    }
    incr n
  }
  if {$s > 1048576} {
    set s [format "%.1fM" [expr $s/1048576.0]]
  }
  set len [llength $glob($inst,filelist)]
  if { $glob(enableautoupdate) != $oldena} {
    set glob(enableautoupdate) $oldena
  }
  $glob(win,$inst).top.stat configure -text \
      "$n/$len = $s [lindex $glob($inst,df) 0]"
  # return indicates if there is a selection...
  return $n  
}


proc ToggleSelect { inst } {
  global glob
  set selected [$glob(listbox,$inst).file curselection]
  $glob(listbox,$inst).file selection set 0 end
  foreach sel $selected {
    $glob(listbox,$inst).file selection clear $sel
  }
  propagateSelection $glob(listbox,$inst).file
  
  UpdateStat
}

# Turns out the bind on <Key> folds Shift-Control-Key into Shift-Key
# so we put in three bindings to seperate them.  Here type will be:
#  {}  simple non-control char
#  c   control-lower case
#  cs  control-shift

# We want to be able to 'ShowListOnKey' without having focus, but only
# having the mouse in the window.We fix this as follows:
# The panes are bound to <Enter> and <Leave> and conspire to set ::inPane
# which is passed here as 'inst'. Thus nil ({}) indicates NOT in a pane.

proc ShowListOnKey { inst char w {type {}}} {
  global glob config
  if {$char == "" || $inst == {}} {return}
  set foc [focus -displayof .]
  frputs inst foc w
  # If focus is in the entry window, do nothing
  if {[string match *.entry_dir $foc]} {return}
  
  if {$config(fileshow,sort) != {nameonly} } {
    set ask [smart_dialog .apop[incr ::uni] .\
		 [_ "Permission to change.."]\
		 [list [_ "Find on first character depends on sorting by 'nameonly'\
                    \nOK to set 'nameonly' sort mode and continue?"]]\
		 0 1 [_ "Yes"] [_ "No"]]
    if {$ask != 0} {return}
    set config(fileshow,sort) nameonly
    ForceUpdate
  }
  set first 0
  set some  0
  set exact 0
  set last [llength $glob($inst,filelist)]
  set mask $config(positiondirs)
  # For control characters we always get the lower case version, thus the type.
  # For type 'oc' we convert the control-char to upper cast.
  if {$type != {}} {
    scan $char %c num
    set char [format %c [expr {$num + ($type == "c" ? 96 : 64)}]]
    set mask [expr {!$mask}]
  }
  set case [expr {$config(sortoption) == "-ascii" ? "" : "-nocase"}]
  set n -1
  set mixed [expr {$config(fileshow,dirs) == "mixed"}]
  foreach k $glob($inst,filelist) {
    incr n
    if {$mixed || ([IsFile $k] ^ $mask) } {
      incr some
      switch [string compare {*}$case -length 1 $char [lindex $k 1]] {
	1  {set first [set last $n]}
        # first is first of right type, but lower than target
        # follow along
	0  {
          if {$exact == 0}  {set first $n}
          # we have exact first
          incr exact
          set last $n
       }
	-1  {
	     set last $n
	     break
	   }
      }
    }
  }
   frputs first last exact char case mask n type some
 if {!$some} {return}
  
  # This is an attempt to dodge the "near visable" thing that see does
  # We want to center the center of the found group This could be better...
  # by looking at total n (llength $filelist)
  set w $glob(listbox,$inst).file
  if {$first > 60} {
    $w see 0
  } else {
    $w see end
  }
  set loc [expr {($first + $last) / 2}]
  $w see $loc
  $w activate $loc
  return
  
  # $glob(listbox,$inst).file see $n
}

proc IsFile { elem } {
  return [expr {[lindex $elem 2] in {l n fl fn}}]
}


#-----------------------------------------------------------------------------

# # The cascade menu. Does NOT work on windows.

#-----------------------------------------------------------------------------

# This routine is called from bindings and fills in the
# index (entry # in dir-list) and the instance (inst left/right)
# which is thus available to the command
# If appropriate it also selects the entry under the pointer

proc DoBut {cmd inst index X Y} {
  global glob config
  frputs cmd inst index X Y
  set glob(doBut,index) $index
  set glob(doBut,inst) $inst
  # set cmd $glob(bind,$which,$inst)
  lassign $cmd isocmd parm
  if {($glob(select_cur_lr) != $inst || $glob(select_cur_s) == {}) && \
	  $cmd ni $config(no_selection) && $inst != "glob" } {  
    SelectThis $inst $index
  }   
  DoProtCmd_NoGrab $cmd
}

proc DoMenu { cmd inst {index 0} {X 0} {Y 0}} {
  global glob
  set glob(doBut,inst) $inst
  frputs "DoMenu >$cmd< $inst $glob(doBut,index) "
  DoProtCmd_NoGrab  $cmd
}

lappend glob(buttoncmds)\
    {ViewOne ViewOne\
         {Same as View on dir. list item under the pointer.}}\
    {ViewDirOpposite ViewDirOpposite\
         {View dir. under pointer in opposite pane.}}\
    {UpDirTree {UpDirTree $inst $X $Y}\
         {Same as up arrow at top of dir. list.}}\
    {Back {Back $inst}\
         {Same as left arrow at top of dir. list.}}\
    {PopupDir {popupDir $inst} \
         {Pop up full dir. name (mouse on dir. line.)} $glob(win,$inst).entry_dir}\
    {PopupListEntry {popupListEn $inst %W @%x,%y 0} \
         {Pop up full file name & link.}}\
    {PopupListDetail {popupListEn $inst %W @%x,%y 1} \
         {Pop up full file detail}}

         

# Rather that repeat a hacked up version of CmdView
# we fake it into working with the file pointed to
# when the button was pressed.  We do this by setting
# up a fake select function which returns the index.

proc ViewOne {} {
  global glob
  set inst $glob(doBut,inst) 
  $glob(listbox,$inst).file activate $glob(doBut,index)
  frputs inst glob(doBut,index)
  TextBoxSelect $glob(listbox,$inst)
  SelectThis $inst $glob(doBut,index)
  CmdView_ SelectFake  glob($inst,filelist) \
      $glob($inst,pwd) $glob([Opposite $inst],pwd) $inst
}

proc SelectFake {args} {
  global glob
  return $glob(doBut,index)
}
#
# The toggle function toggles config binary values.
# For use in 'bind' configure objects, 
# e.g. config(bind,t) Toggle config(fileshow,all)
proc Toggle {what} {
  global config
  set $what [expr { ! [set $what]} ]
  ForceUpdate
}

proc ViewDirOpposite {{selected 0}} {
  global glob
  set inst $glob(doBut,inst)
  if {$selected} {
    set sel [$glob(listbox,$inst).file curselection]
    if {$sel == {}} {return}
    lassign $sel ind x
  } else {
    set indx $glob(doBut,index)
  }
  set fileelem [lindex $glob($inst,filelist) $indx]
#  puts "here $glob(doBut,inst) $glob(doBut,index) >$fileelem<"
  switch [lindex $fileelem 2] {
    wld {
      set newdir [TranslateLnk [wLinkName $inst $fileelem] \
		      [lindex $glob($inst,df) 1]]
      # frputs "TranslateLnk of [wLinkName $inst $fileelem] returns  " newdir
      if {$newdir != {}} {
	NewPwd [Opposite $inst] $newdir
	UpdateWindow [Opposite $inst]
      } else {
	PopInfo [_ "Failed to translate windows lnk:\
                    %s"  [wLinkName $inst $fileelem]]
	return
      }
    }          
    fd  -
    fld -
    ld  - 
    d   { 
      NewPwd [Opposite $inst] [DNtoDirTail $glob($inst,pwd)/[lindex $fileelem 1]]
      UpdateWindow [Opposite $inst]
    }
  }
}

proc Opposite { inst } {
  return [expr {$inst == "left" ? "right" : $inst == "right" ? "left" : \
		    [error [_ "Internal error (%s)" $inst]]}]
}

proc CheckAbort { info } {
  global glob
  update
  if { $glob(abortcmd) > 0} {
    Log [_ "%s aborted" $info]
    # This indicates that the abort was delivered...
    set glob(abortcmd) 0
    return 1
  }
  return 0
}

proc CantDoThat { } {
  PopInfo [_ "It would be cool if FileRunner could do that, but it can't (yet)..."]
}

proc DoUsrCmd { proc } {
  global glob
  set r [DoUsrCmd_ $glob(listbox,left).file \
	     glob(left,filelist) $glob(left,pwd) $glob(right,pwd) $proc]
  if {$r} {
    UpdateWindow both
    return
  }
  set r [DoUsrCmd_ $glob(listbox,right).file \
	     glob(right,filelist) $glob(right,pwd) $glob(left,pwd) $proc]
  if {$r} {
    UpdateWindow both
    return
  }
  Try {$proc {} $glob(right,pwd) $glob(left,pwd) $glob(mbutton)}
  UpdateWindow both
}

proc DoUsrCmd_ { listb_name filelist_var frompwd topwd proc } {
  global config glob
  upvar $filelist_var filelist

  set fl {}
  foreach sel [$listb_name curselection] {
    if {[CheckAbort "UserCommand $proc"]} return
    set elem [lindex $filelist $sel]
    lappend fl [lindex $elem 1]
  }
  if {$fl == ""} {return 0}
  Try {$proc $fl $frompwd $topwd $glob(mbutton)}
  return 1
}

proc CheckWhoOwns { file action } {
  global config
  if {!$config(check_ownership)} {
    return 1
  }
  set r [CheckOwner $file]
  if {$r} {return 1}
  set r \
      [smart_dialog .apop[incr ::uni] . "!" \
	   [list {} $file [_ " is not owned by you.\
                         \nOK to try to %s anyway?" $action ]]\
	   0 2 \
	   [list [_ "Yes"] [_ "No"]]]
  if {$r == 0} {return 1}
  return 0
}

# 0 means yes
# 1 means no
# 2 means cancel or s/he destroyed the window
proc yesNoCancel {master title mess} {
  set r [smart_dialog .query[incr ::uni] $master $title \
	     [list $mess]\
	     0 3 [list [_ "Yes"] [_ "No"] [_ "Cancel"]]]
  return [expr {$r < 0 ? 2 : $r}]
}

proc simple_smart_dialog {master title mess hint {cancel {}}} {
  # This just makes a common call to smart_dialog to get a new value for
  # 'hint'.  master should be the master window, title the windows title,
  # mess the info message, and hint the suggested value.
  # return will be the new value for 'hint' which could be {} if
  # cancel or window abort or s/he actually clears the input field

  set ::ssdTmp $hint
  set r  [smart_dialog .window[incr ::uni] $master $title \
	      [list $mess] \
	      0 3 \
	      [list \
		   [list {} [list -textvariable ::ssdTmp -width 70]]\
		   [_ OK] [_ Cancel]]\
	      [list focus 0]\
	      [buildDialogConfig]\
	     ]
  if {$r == -1 || $r == 2} {
    return $cancel
  }
  return $::ssdTmp
}

proc cent {w m} {
  centerWin $w $m
  centerMouse2 $w.0
}



proc AppendToDirHistory {dir} {
  global glob
  set found_index [lsearch -exact $glob(history) $dir]  
  if { $found_index >= 0} {
    set glob(history) [lreplace $glob(history) $found_index $found_index]
  }
  set glob(history) [linsert $glob(history) 0 $dir]
  set glob(history) [lrange $glob(history) 0 30]
}


proc CreateHistoryMenu { inst } {
  global glob
  set menun $glob(win,$inst).dirmenu_frame.history_but.m 
  $menun delete 0 end
  # while we are here, purge entries for dirs that do not exist.
  set newH {}
  foreach dir $glob(history) {
    if {![IsVFS $dir] && ![file exists $dir] && $dir != {}} {continue}
    $menun add command -label [dirToDN $dir] -command "CdHistory ${inst} \{$dir\}"
    lappend newH $dir
  }
  set glob(history) $newH
}

proc CdHistory { inst dir } {
  global glob
  DoProtCmd "
    NewPwd ${inst} \{$dir\}
    UpdateWindow ${inst}
  "
}
proc ifExists {name file} {
  return [expr {[file exists $file] | [file exists $file.gz] ? \
		    [list [list [_ $name] $file]] : {}}]
}
proc CreateHelpMenu { } {
  global glob
  set thisMenu $glob(win,top).menu_frame.help_but.m
  $thisMenu delete 0 end
  buildCasMenu {}\
      [list \
	   {*}[ifExists "QuickStart"   $glob(doclib_fr)/QuickStart.txt]\
	   {*}[ifExists "User's Guide" $glob(doclib_fr)/Users_Guide.txt]\
	   {*}[ifExists "Copying"      $glob(doclib_fr)/COPYING]\
	   {*}[ifExists "Eula"         $glob(doclib_fr)/Eula]\
	   {*}[ifExists "History"      $glob(doclib_fr)/HISTORY]\
	   {*}[ifExists "Installation" $glob(doclib_fr)/README]\
	   {*}[ifExists "FAQ"          $glob(doclib_fr)/FAQ]\
	   {*}[ifExists "Tips"         $glob(doclib_fr)/Tips.txt]\
	   {*}[ifExists "Known Bugs"   $glob(doclib_fr)/KnownBugs.txt]\
	   {*}[ifExists "To Do"        $glob(doclib_fr)/To_Do.txt]\
	   {*}[ifExists "inotify"      $glob(conf_dir)/inotify-message]\
	  ] \
      $thisMenu\
      ViewTextH
}

proc ViewTextH {file args} {
  ViewHelp $file
}

proc addDotToPath {inst} {
  global glob env
  set delim [expr {$::MSW ? ";" : ":"}]
  if {$glob($inst,pwd) ni [split $::env(PATH) $delim]} {
    set env(PATH) $::env(PATH)$delim$glob($inst,pwd)
  }
}

proc CreateEtcMenu {w inst} {
  global glob
  # We only put up what is useful...

  set vfsMenu {}
  
  if {[set isvfs [IsVFS $glob($inst,pwd)]]} {
    # Lets put the memory for this in the VFS space
    VFSglobal findMenu locateMenu touchMenu
    foreach var {findMenu locateMenu touchMenu} {
      if {![info exist $var]} {
	if {[catch {
	  VFScommand $VFStok [list command  -v [string range $var 0 end-4]]
	} val] != 0 || \
		[string index [lindex [split $val \n] end] 0] != "/"} {
	  set val {}
	}
	set $var $val
      }
    }
    if {[catch {VFSmenu $VFStok $inst} vfsMenu] != 0} {
      set vfsMenu {}
    }
  }
  if {!$isvfs || $findMenu != {}} {
    lappend vfsMenu \
	{+-label {Find File...}           -command {CmdFind $inst}}\
	{+-label {Find   | Command...}    -command {CmdFind $inst recur 1}}
  }
  if {!$isvfs || $locateMenu != {}} {
    lappend vfsMenu \
	{+-label {Locate File(s)...}      -command {CmdFind $inst cmd locate}}\
	{+-label {Locate | Command...}    -command {CmdFind $inst cmd locate recur 1}}
  }
  if {!$isvfs || $touchMenu != {}} {
    lappend vfsMenu \
	{+-label {Create Empty File...}   -command {CmdCreateEmptyFile $inst}}\
	{+-label {Add this Dir to Path}   -command {NP addDotToPath $inst}}
  }
  if {$isvfs} {
    lappend vfsMenu \
	{-label {Add To VFS Batch List}      -command {AddToBatchList $inst}}\
	{-label {VFS Copy With Resume}       -command {CmdCopy {resume 1}}}\
	{-label {VFS Copy With Resume/Async} -command {CmdCopy {async 1 resume 1}}}
  }
  lappend vfsMenu \
      {-label {View VFS Batch List}   -command {NP ViewBatchList}}\
      {-label {Clear VFS Batch List}  -command {NP set glob(batchlist) {}}}\
      {-label {VFS Batch Receive}     -command {BatchReceiveVFS $inst}}\
      {-label {HTTP Download}         -command {CmdGetHttp $inst}}

  $w delete 0 end
  ButtonAdd $w $inst $vfsMenu
}

proc CreateHotListMenu {inst} {
  global glob config DNlist hotlistExclusion
  if {![info exists hotlistExclusion]} {
    set hotlistExclusion {}
  }
  # We want to put the Display names first...
  set dnameList {}
  foreach {dir dname} $DNlist {
    if {$dir in $hotlistExclusion} {continue}
    lappend dnameList [list $dname $dir]
  }
  set dnameList [lsort -index 0 $dnameList]
  frputs dnameList
  buildCasMenu [list {}  [list [_ "Add \"%s\" to hotlist" $glob($inst,pwd)]] {}] \
      [concat $dnameList [list {}] $config(hotlist)] \
      $glob(win,$inst).dirmenu_frame.hotlist_but.m\
      [list hotlistHandler $inst]\
      -tearoffcommand FixTearoff\
      filter dirToDN\
}
proc hotlistHandler {inst dir list ent} {
  frputs ent dir list
  global glob config
  if {$list == 2} {
    DoProtCmd "
      NewPwd $inst [list $dir]
      UpdateWindow $inst
    "
  } else {
    if {$ent == 1} {
      set config(hotlist) [linsert $config(hotlist) 0 [list $glob($inst,pwd)]]
    }
  }
}

proc getFileContent {filename content} {
  upvar $content MyContent
  if {[IsVFS $filename]} {
    set filename [MoveToTmp $filename]
  }
  if {[catch {open $filename r} fid] != 0} {
    PopError "$fid"
    return -code 2
  }
  # Here is a trick. If the file name ends with .gz or .zip,
  # put a conversion filter in place to decompress the file
  set ext [string tolower [file ext $filename]]
  if {$ext == ".zip"} {
    zlib push decompress $fid
  } elseif {$ext == ".gz"} {
    zlib push gunzip $fid
  }
  # Check file size here and if LARGE, ask...
  if {[set r [catch {file size $filename} an]] != 0 || $an > 1000000} {
    # over a megabyte, lets ask...
    if {$r != 0} {
      set mes "Error trying to get file size. Continue to try and display?"
    } else {
      set mes "File size is $an. Do you really want to try and display it?"
    }
    if {[yesNoCancel . {Really big} $mes] != 0} {
      return -code error  "NoReport"
    }
  }
  if {[catch {read -nonewline $fid} MyContent] != 0} {
    PopError "$MyContent"
    catch {close $fid}
    return -code 2
  }
  close $fid
  return $filename
}

proc ViewText { filename {realName {}}  args} {
  set realName [expr {$realName == {} ? $filename : $realName}]
  set filename [getFileContent $filename content]
  frputs realName
  set title [_ "Viewing %s" "[file tail $realName] at: [file dir $realName]"]
  foreach {item var} $args {
    set $item $var
  }
  ViewString  $title content\
      filename $realName\
      modified [expr {$filename != $realName}]
}

proc undoHelp {w undo} {
  global glob
  catch {destroy .apop}
  set r [catch {$w edit $undo} err]
  if {$r} {
    smart_dialog .apop[incr ::uni] $w {Info} [list {} $err] \
	0 0 {} [list -flashcolor $glob(gui,color_flash)]
  }
}
# # fillTextWindow w var_string ?tag?
# # tag, if coded is added to each text window insert
# # If there are no overstrikes in the string, we just do the insert.
# # Otherwise we call the fillTextWindowOverstrike code which normally
# # would not be loaded.


# ViewString title var args
#     title is passed to the window
#     var   is the name of the variable which has the string we
#           populate the window with

# in ViewString 'args' (optional) list of pairs. Ones we recognize:
# filename <filename>  defaults to {}
# SearchConfig <script>  if present call script to set search options
# ReadOnly     1         if 1, make the window read only
# optionFlags  boolean   0 to remove 'follow' from the <3> manu
# spellOps     boolean   0 to remove spell check ops
# undo         boolean   0 to remove undo...redo
# utf16        first element in the <3> menu, default is 'Convert UTF16'
#              {} eliminates. Could also put something else here (but we don't)
# geo          config(geometry,$geo) is used as window geometry (must exist)
#              default is 'textviewer' intended option is 'qedit'
# nomodify     1          don't attempt backspace formatting

proc ViewString { title var_string args} {
  global glob config
  upvar $var_string string
  set w .toplevel_$glob(toplevelidx)
  incr glob(toplevelidx)
  set filename {}
  # set minText "75x5"
  set SearchConfig {}
  set spellOps    1
  set undo        1
  set optionFlags 1
  set ReadOnly    0
  set modified    0 ; # indicates file contents modified (possibly *.gz)
  set nomodify    0  ; # don't attempt backspace formatting
  set utf16 [list [_ "Convert UTF-16"] "ReReadUTF16 $w.text [list $filename]" ]
  set geo "textviewer"
  
  foreach {item val} $args {
    set $item $val
  }


  # frputs "View String window  " w
  toplevel $w
  wm att $w -alpha 0.0
  wm title $w "$glob(orgTitle) $title"
  wm iconname $w "$title"
  # wm geometry $w [getGeo $config(geometry,$geo) $w]
      #
  scrollbar $w.scroll -command "$w.text yview" 
  text $w.text \
      -relief sunken -bd 2 \
      -yscrollcommand "$w.scroll set" \
      -wrap word \
      -undo 1 \
      -font $glob(gui,ListBoxFont) \
      -exportselection 1\
      -highlightthickness 0
  frputs "[$w.text cget -height] [$w.text cget -width] "
  button $w.quit\
      {*}[getImage -bitmap cross @$glob(lib_fr)/bitmaps/cross.bit]\
      -command "destroy $w"\
      -width 11\
      -height 11\
      -bd 1
  
  set spellops [list\
		    {*}[spellCheckText $w.text -log LogStatusOnly -file $filename\
			    -filter $config(spellingFilter)\
			    -expect $config(spellcheck,expect)]]  

  set seGrip [segrip $w]
  set swGrip [swgrip $w]
  $swGrip config -width 3 -height 3 -anchor sw
  grid $w.quit -in $w -row 3 -column 2 -sticky news
  grid $w.quit          -row 3 -column 2               -sticky ne
  grid $w.scroll -in $w -row 4 -column 2 -columnspan 2 -sticky nse
  grid $seGrip   -in $w   -row 5 -column 2               -sticky se
  grid $swGrip   -in $w   -row 5 -column 0               -sticky sw
  grid $w.text   -in $w   -row 3 -column 0 -rowspan 3    -sticky news
  grid columnconfig $w 0 -weight 1
  grid rowconfig $w 4 -weight 1
  # Here we do "back-space" formatting. There are two possible backspace
  # flags we detect. _{bs} means the following character is to be underlined
  # and              C{bs} means the following character is to be bold.
  #                        Usually the following character is the same i.e. C
  if {!$nomodify} {
    set modified [expr {[set f [fillTextWindow $w.text string]] | $modified }]
  } else {
    $w.text insert insert $string 
  }
  frputs f
  wm protocol $w WM_DELETE_WINDOW \
      "EditTextCheckPoint [list $filename] $w.text $modified"
  # $w.text insert 0.0 $string
  $w.text mark set insert 0.0
  $w.text edit reset
  $w.text edit modified 0
  ::autoscroll::autoscroll $w.scroll
  destroy $w.text.p
  intelWinSize $config(geometry,$geo) $w.text
  wm att $w -alpha 1.0
  set redo [expr {$::MSW ? "C-y" : "C-Z"}]
  # There seems to be a lot on verbage on the web as to how to make a text
  # window read only. The approach we take is to use the UnDo to just undo
  # any changes.  In all other respects the window is a normal text window.
  # We do, however, change the "textsearch" menu to remove the undo, etc.'
    
  set Ops {}
  if {$ReadOnly} {
    bind $w.text <<UndoStack>> [list doReadOnly $w.text]
    set utf16 {}
    set spellops {}
  } else {
    if {$undo} {
      set Ops [list \
                   [_ "Undo"] [list ? "undoHelp $w.text undo" -accelerator C-z]\
                   [_ "Redo"] [list ? "undoHelp $w.text redo" -accelerator $redo]]
    }
    if {!$spellOps} {
      set spellops {}
    }
  }
  if {$SearchConfig == {}} {
    textSearch $w.text "$title" "+buildViewConfig ViewEditStrings" \
	[list {*}$utf16]\
	[list {*}$Ops \
	     {*}$spellops\
	{*}[ViewOptionsIfFile $filename $w $optionFlags]\
	[_ "Save As..."] [list ? [list SaveToFile $w.text $filename 1] \
			      -accelerator C-S]\
	[_ Quit] [list ? [list EditTextCheckPoint $filename $w.text $modified]\
		      -accelerator C-q]]
    
    #bind $w.text <Control-s> [list SaveToFile $w.text  $filename 0]
    bind $w.text <Control-S> [list SaveToFile $w.text [list $filename] 1]
    bind $w.text <Control-q> \
	[list EditTextCheckPoint [list $filename] $w.text $modified]
  } else {
   eval [list {*}$SearchConfig $w $title $filename $var_string]
  }
  bind $w.text $config(mwheel,neg) \
      "$w.text yview scroll -$config(mwheel,delta) units;break"
  bind $w.text $config(mwheel,pos) \
      "$w.text yview scroll $config(mwheel,delta) units;break"
  # window name is returned for use by the log code.

  return $w
}

proc doReadOnly {w} {
  while {[$w edit canundo]} {$w edit undo}
}

# Come here when the window is being wiped and it has been modified
proc reallyDone {w} {
}

# option is true if 'follow option is desired'
proc ViewOptionsIfFile {filename w options} {
  # These options only make sense if there is a filename...
  if {$filename != {}} {
    bind $w.text <Control-s> [list SaveToFile $w.text $filename 0]
    # lassign [split [$w.text index "end-1 chars"] "."] next
    # don't follow VFS files (maybe later in some cases...)
    if {$options && ![IsVFS $filename]} {
      lappend ret  [_ "Follow end"] \
	  [list followFile $w.text $filename [file size $filename]]
    }
    return [lappend ret \
		[_ "Revert File"] [list ReRead $w $filename] \
		[_ "Save"       ] [list ? [list SaveToFile $w.text $filename 0] \
				       -accelerator C-s]\
		[_ "Save&Quit"] [list SaveEditedText $filename $w.text]]
  }
  return {}
}

proc ReRead {w filename} {
  set index [$w.text index current]
  if {[$w.text edit modified]} {
    set r [yesNoCancel $w.text [_ "What to do?"]\
	       [_ "This will destroy your changes. Do you want to continue?"]]
    if {$r != 0} {
      focus $w
      return
    }
  }
  getFileContent [lindex $filename 0] content
  $w.text delete 0.0 end
  $w.text insert 0.0 $content
  $w.text mark set current $index
  $w.text edit reset
  $w.text edit modified 0
}

proc ReReadUTF16 {w filename } {
  set txt [regsub -all {\x00} [$w get 1.0 end] {}]
  # set txt [subst -nocommands -novariable $txt]
  $w replace 1.0 end $txt
  $w mark set insert 0.0 
}


proc SaveToFile { w filename ask args } {
  # undo any "list" mods:
  # set filename [lindex $filename 0]
  frputs w filename ask args
  global env glob
  if {$ask || $filename == {}} {
    if {$filename == {}} {
      set filename $env(HOME)/
    }
    set filename [simple_smart_dialog $w [_ "What file?"]\
       [_ "Enter name of file to save to"] $filename]
    if {$filename == ""} {return 0}
  } else {
    if {$filename == ""} {PopError [_ "Null filename"]}
  }
  set tmpFile $filename
  set r 0
  if {[IsVFS $filename]} {
    # For VFS we first save it in a tmp area
    if { ! [file exists $glob(tmpdir)] } {
      set r [Try { file mkdir $glob(tmpdir) }]
    }
    if {$r} {
      PopError [_ "Failed to create %s " $glob(tmpdir)]
      return 1
    }
    set tmpFile $glob(tmpdir)/[file tail $filename]
  }
  frputs w tmpFile
  set r [Try {
    set fid [open $tmpFile w]
    puts -nonewline $fid [$w get -displaychars 0.0 end]
    close $fid}]
  
  if {!$r && $tmpFile != $filename} {
    # Now put the file to the VFS location
    set r [Try {VFSputFile $filename $tmpFile [file size $tmpFile] }]
  }
  if {$r} {
    return 1
  }
  $w edit modified 0
  Log [_ "Saved: %s" $filename]
  UpdateIf $filename
  return 0
}

proc EditText {filename {realName {}}} {
  set realName [expr {$realName == {} ? $filename : $realName}]
  getFileContent $filename content
  set w [ViewString [_ "Editing %s" $filename] content \
	     filename $realName \
	     nomodify 1\
	     optionFlags 0 \
	     utf16 {}\
	     geo qedit]
  set size_file [file size $filename]
  set size_text [string length [$w.text get 0.0 end]]
  if { $size_file != $size_text } {
    PopWarn [_ "Editing:\nCharacters lost/added when converting\
       %s to text.\nOld size: %s\nNew Size: %s" $filename $size_file $size_text]
    # puts "call2 $w"
  }
}

# w should be the text window...
proc EditTextCheckPoint { filename w  {modified 0}} {
  # modified here means that the data from 'filename' was altered before
  # being posted to the window (e.g. *.gz or backspace formatting)
  # If so we don't offer to save the file
  global config
  frputs #2 filename w modified
  # Ask about saving only if modified
  if {![winfo exists $w]} {
    # puts "EditTextCheckPoint $filename $w"
    return
  }
  # If the window was modified &&
  # we have a file name &&
  # the file was not modified from that contents prior to postion to the window &&
  # they want us to warn them
  if {[$w edit modified] && \
	  $filename != {} && \
	  !$modified &&\
	  $config(ask,save_modified_file)} {
    set ms  [_ "Do you want to save before exiting?"]
    append ms\
	[expr {$config(ask,save_modified_file) && $filename == {} ? \
		   [_ "\n(Disable with \"config(ask,save_modified_file)\" option.)"]\
		   : {}}]
    set r [smart_dialog .editq[incr ::uni] $w [_ "What to do?"]\
	       [list $ms]\
	       0 3 [list [_ "Yes"] [_ "No"] [_ "Cancel"]]]
    switch $r {
      0 { SaveEditedText $filename $w}
      1 { catch {destroy [winfo parent $w]}}
      default {}
    }
  } else {
    catch {destroy [winfo parent $w]}
  }
}

proc SaveEditedText { filename w } {
  if {! [SaveToFile $w $filename 0]} {
    catch {destroy [winfo parent $w]}
  }
  UpdateWindow both
}

proc VFSEntryDialog { wm_title info_text start_entry } {
  global glob

  set glob(.vfs_usr) $start_entry
  set glob(.vfs_showpw) 0
  set rt [smart_dialog .vfs_entry_dialog[incr ::uni] . $wm_title \
	      [list [_ "%s\n\nOK activates, cancel or window-delete cancels."\
			 $info_text]]\
	      2 5 \
	      [list \
		   [list [_ "Username:"] {-textvariable glob(.vfs_usr)}]\
		   [list [_ "Password:"] {-textvariable glob(.vfs_paswd) \
					      -show "*" }]\
		   [list [_ "OK"]]\
		   [list [_ "Show password"] \
			{-variable glob(.vfs_showpw) -command vfsPwShow}]\
		   [list [_ "Cancel"]]\
		  ]\
	      [buildDialogConfig]\
	     ]
  if {$rt == -1 || $rt == 4} {return {}}
  return [list $glob(.vfs_usr) $glob(.vfs_paswd)]
}

proc vfsPwShow {} {
  global glob
  set showChar [expr {$glob(.vfs_showpw) ? {} : {*}}]
  .vfs_entry_dialog.1 config -show $showChar
}

# This little proc is passed to frECF as a post routine to post
# the the result in a ViewString window or what ever...
# At this point we only handle call by name for the data which
# works fine with ViewString ...

proc postOptions {where nodata data} {
  upvar $data string
  # frputs  where nodata data string
  
  if {[string index $where end-1] == "&" && \
	  [regexp {^[0-9 \n]*} $string] } {
    # background and only pids reported back
    return
  }

  if {$string == {}} {
    if {$nodata != "nop"} {
      eval [list {*}$nodata]
    }
    return
  }
  eval [list {*}$where string modified 1]
}

# The 'actualFile' routine and checks to see if it is a link. If it is
# it passes back the actual name, if not, the passed in name is returned

proc actualFile {name} {
  if {[catch {LnkFile $name} rtn] == 0 && $rtn != $name} {return $rtn}
  if {[catch {file link $name} to] == 0} {return $to}
  return $name
}

# The ViewAny routine is called (among other places) from open where,
# if in windows, we want the orgional filename to pass to the windows cmd
# thus, in that case, we hope to find an original file name in filenameorg
# which should be the same as filenamelist except in the case of a lnk file.

proc ViewAny { filenamelist {extensionList view} {filenameorg {}}} {
  global glob config
  #puts $filenamelist
  set firstfile [lindex $filenamelist 0]
  if {$firstfile == {}} {return}
  while {[incr try] <= 2} {
    set found ""
    foreach k $config($extensionList,extensions) {
      foreach l [lindex $k 1] {
	if {[string match -nocase $l $firstfile]} {
	  set found [lindex $k 0]
	  break
	}
      }
      if {$found != ""} break
    }
    if {[string match -nocase $found "try open"] && $extensionList == "view"} {
      set extensionList "open"
      continue
    }
    break
  }
  if {$found == "" && $extensionList == "view"} {
    foreach filename $filenamelist filenameo $filenameorg {
      ViewText $filename $filenameo
    }
    return
  }
  # for the rest of these we want to make sure the file is local
  frputs found
  foreach file $filenamelist {
    if {[IsVFS $file]} {
      set file [MoveToTmp $file]
    }
    lappend newlist $file
  }
     
  if {$found != ""} {
    if {[lindex $k 2] == "-viewtext"} {
      foreach file $newlist {
	Log "Running exec [subst {*}$::stOps $found] $file"
	frECF [list exec {*}[subst {*}$::stOps $found]]\
	    [list $file]\
            -x 1 -w 1\
	    [list -post \
		 [list postOptions\
		      [list ViewString \
			   [_ "Viewing %s" "[file tail $file] at: [file dir $file]"]] nop]]
      }
    } else {
      frECF [list exec {*}[subst {*}$::stOps $found] %b &] \
	  $newlist -x 1 -w 1
    }
    return
  }
  # Ok, we did not trap it above.  Try the open trick. 
  
  # if the file is executable, do that, else call the open thing
  # here is the only place we care about the filenameorg list
  set index -1
  set file {}
  foreach filename $newlist {
    incr index
    # set file [FixFileNameO [file native $filename] 1 {\[ $} ]
    frputs "in viewany- open  " filename "->  " file index
    if {! $::MSW && [file executable  $filename ]} {
      # not MSW and executable
      # verify executable by checking mime type
      Log "exec file -b $filename"
      # set r  [catch [ReSpaceString "exec file -b" "$file"] out]
      set rr [frECF {exec file -b} [list $filename] -x 1 -w 1]
      lassign $rr r out
      frputs "After frECF:  " out r
      if {$r == 0} {
	if { [string match {*executable*} $out] && \
		 ![string match {*MS Windows*} $out]} {   
	  Log "exec $filename &"
	  set rr [frECF {exec %b &} [list $filename] -x 1 -w 1]
	  lassign $rr r out
	  if {$r != 0} { 
	    Log "error: $out"
	  }
	  continue
	  # set r [catch  [ReSpaceString "exec" "$file &"] out]
	}
      }
    }
    # linux executables done above.
    if {$::MSW && $filenameorg != {}} {
      # on windows, execute the original *.lnk if available
      set filename [lindex $filenameorg $index]
    }
    # set possible cmd (esp for linux)
    if {[info procs [lindex [set opCmd $config(cmd,open)] 0]] == {} ||\
	    ![regexp {^ *twapi::.*} $opCmd]} {
      set cmd [list "exec" {*}[subst {*}$::stOps $opCmd] %b &]
    } else {
      set cmd [list {*}[subst {*}$::stOps $opCmd] %b]
    }
    # see if we can find a proper file to run this with..
    if {$::MSW} {
      if {[string match -nocase ".lnk" [file extension $filename]]} {
        # it is a link which may have additional info.
        # Let twapi::shell_execute command figure it out.
        if {[catch {twapi::shell_execute -path [file native $filename]} er] !=0 } {
          Log "error: $er"
        }
        return
      }
      if {[set cmdt [auto_execok $filename]] != {}} {
        # if MSW set up its open thing. Note that with our extension
        # (auto_execok) we bend some linux code (e.g. scripts)
        # to work on MSW.
        # if 'auto_execok' passes something back it is either the
        # whole string to run or what to execute & the parm. This should
        # work either way...
        set filename [lassign $cmdt cmdx]
        set cmd [list exec $cmdx  &]
        # set filename $cmdt 
        # set cmd [list exec   &]
        frputs cmdt cmdx cmd filename
      }
    }
    # so now we can do a common cmd...
    set rr [frECF $cmd [list $filename] -x 1 -w 1]
    lassign $rr r out
    if {$r != 0} { 
      Log "error: $out"
    }
  }
  return
}



proc UnArcPackAny { file dir which} {
  global config glob
  set found ""
  foreach k $config(cmd,$which,extensions) {
    foreach l [lindex $k 1] {
      if {[string match [string tolower $l] [string tolower "$file"]]} {
        set found $k
        break
      }
    }
    if {$found != ""} break
  }
  if {$found == ""} {
    PopWarn [_ "Cannot find %s rule for %s" $which $file]
    return
  }
  frputs file "[subst [lindex $k 0]] " k
  cd $dir
  # if {$::MSW && 0} {
  #   set cmd [fixMSWcommand [list exec {*}[subst {*}$::stOps [lindex $k 0]]]\
  #       	 [list $file]\
  #       	 [list -fonly 1]]
  # } else {
    set cmd [frECF [list exec {*}[subst {*}$::stOps [lindex $k 0]]]\
		 [list $file] \
                 -f 1 -w 1 -x 1]
  # }
  Try $cmd $glob(async)
  # set ex [format [FixFormatString [lindex $k 0]] \
  # 	      [FixFileNameO [file native $file] 3 {\[ $}]]
  # set cmd [ReSpaceString exec $ex]
  #
  # frputs "unArc/Pack command:  " cmd
  # Try $cmd "" 1 $glob(async)
}

proc TabBind { list } {
  set i [lsearch -exact $list [focus]]
  incr i
  if {$i >= [llength $list]} {
    set i 0
  }
  catch {focus [lindex $list $i]} out
  #  catch {[lindex $list $i] }
}


proc PopInfo { info } {
  smart_dialog .apop[incr ::uni] . [_ "Info"] [list $info] 0 1 [_ "OK"]
  #LogSilent "**Info**\n$info"
}

proc PopWarn { warn } {
  global glob errorInfo
  if {$glob(debug)} {
    set this "*[regsub {\n.*} $errorInfo {}]*"
    if {[string match $this $warn]} {
      append warn "\n$errorInfo"
    }
  }
  smart_dialog .apop[incr ::uni] . [_ "Warning"] [list $warn] 0 1 [_ "OK"]
  LogStatusOnly "[lindex [split $warn \n] 0]"
  LogSilent [_ "**Warning**\n%s" $warn]
}

# The Clean proc destroys all toplevel windows except the 
# Error window.

proc Clean {} {
  foreach win [winfo children .] {
    if {[string match ".toplevel_*" $win]} {
      destroy $win
    }
  }
}
set glob(lastError) {}

proc PopError { error } {
  global glob config errorInfo
  set errorInfoLoc $errorInfo
  IsKnownError $error
  # stop any progress bar
  LogStatusOnly {} -1
  if {$error == $glob(lastError)} {
    set error [_ "Repeat of last error."]
  } else {
    set glob(lastError) $error
  }
  frputs #2 #1 "PopError  " error
  set er ""
  if {![info exists glob(errorWindow)] || ![winfo exists $glob(errorWindow)]} { 
    set glob(errorWindow) [ViewString [_ "**Error**"] er ]
    set w $glob(errorWindow)
#    puts "window name is >$w<"
    wm protocol  $w WM_DELETE_WINDOW \
	 PopErrorClean
    $w.quit configure \
	-command PopErrorClean
    # Rewrite the 'Quit' command to save the window
    $w.text.p entryconfigure last \
	-command PopErrorClean
    $w.text.p insert 1 command \
	-label {Clear error window} \
	-command "$w.text delete 0.0 end
                  set glob(lastError) {}"
    bind $w  <Escape> PopErrorClean
    # $w.text insert end [_ "Error window"]
  }
  set w $glob(errorWindow)
  if {$error != {}} {
    set error     [regsub -all {\r} $error     {}]
    set errorInfoLoc [regsub -all {\r} $errorInfoLoc {}]
    $w.text mark set insert end
    $w.text insert end "\n=============\n$error"
    if {$glob(debug)} {
      $w.text insert end "\n==errorInfo==\n${errorInfoLoc}"
    }
    LogStatusOnly "[lindex [split $error \n] 0]"
    LogSilent [_ "**Error**\n%s" $error]
  }
  $w.text see end
  wm withdraw $w
  # resize the window
  intelWinSize $config(geometry,textviewer) $w.text min fxa2
  wm deiconify $w
  $w.text.p unpost
#  ViewString "**Error**" error ""
}
proc PopErrorClean {} {
  global glob
  wm  withdraw $glob(errorWindow)
  # clean up any lingering tearoffs
  eval {eval [bind $glob(errorWindow) <Destroy>]}
} 
# This is a companion to the Try code. It manages the "Stop" button
# and keeps track of the number of async streams we have at any one time
# proc endAsync {} {
#   global glob
#   if {[incr glob(asyncCount) -1] <= 0} {
#     set glob(asyncCount) 0
#     # $glob(win,top).menu_frame.abort config -state disabled
#   }
# }

# This is a two part (i.e. proc) set up that launches and
# keeps track of (well for now, it knows when it ends) an async
# function call.  It is assumed that we get the 'script' to be
# executed which may have function calls and variable references
# in it. These calls and variables are dereferenced using 'subst'
# at the callers 'level' in the stack before the 'after 0' call
# which actually launches the async execution. The script is
# dereferenced at 'level' which defaults to 1. The 'level'
# parameter is provided for cases where the caller is a function
# acting on behalf of its caller.

# The script is "added to" with a call to 'endAsync' which clocks
# the async code out (notes that it completed). Also the script
# is executed in a 'catch' environment to allow us the trap
# errors.

proc tendAsync {script args} {
  global glob
  # we are in the async mode...
  frputs script 
  # We catch errors so we can allow "error" on async stop
  # and to preserve some semblance of the asyncCount

  # At any given time there will be 'asyncCount' tasks running
  # The 'index' at level 1 (this level) points to the task's task
  # in ::asyncTasks which will be empty if no async tasks are running.

  # For async tasks which are polling we can set a flag they can find
  # using the value of index after 'upvar #1 index index' or
  # 'uplevel #1 {set index}'
  if {[set index [incr glob(asyncCount)]] >= 1} {
    $glob(win,top).menu_frame.async config\
	-text [_ "Async %s" $glob(asyncCount)]\
	-bg   $glob(gui,color_highlight_fg)
  }
  set ::asyncTasks($index) $script
  set r [catch {eval $script} out options]

  # End of async command. Dec the count and check for errors
  if {[incr glob(asyncCount) -1] <= 0} {
    set glob(asyncCount) 0
    condResetAbt
    $glob(win,top).menu_frame.async config -bg $glob(gui,color_scheme)
  }
  unset ::asyncTasks($index)
  $glob(win,top).menu_frame.async config -text [_ "Async %s" $glob(asyncCount)]

  if {$r == 0} {return}
  #
  # Some sort of error, could be an "async Stop"
  #
  frputs out "[info level] " ::errorInfo
  if {[string match {*async abort*} $out]} {
    set glob(abortcmd) 0
    LogSilent "Async Stop: $out"
    return
  }
  TryReportErrors $out $args
  return
}

# The 'condResetAbt' routine reset the abort flag if both the
# DoProtLeve and the asyncCount are zero. It is called when
# we exit either of these.

proc condResetAbt {} {
  global glob
  if {$::DoProtLevel == 0 && $glob(asyncCount) == 0} {
    set glob(abortcmd) 0
  }
}
# Try returns 0 if no error, else 1
# Lets try a cleaner interface:
# Was: tryscript<script> excuse<string> alsoPrintError<bool> ?async <bool>?
# Now: tryscript<script> args..
# Where args: each one of: -s<string> or -q or -a or
#             as the old call.
#           The -q means no error print, the majority of calls want errors printed
#           also the majority have no "excuse" string.
# Because of the need to evaluate variables (i.e. $v substution) in the callers
# context and, if "async" to run in a different context we have some rules on the
# construction of the "Try" script:
#
# 1.) do NOT put protected commands (i.e.{... [command...]...}) in the script.
# 2.) do NOT use {*} in the script, use quotes and not {} and the {*} is not
#     needed. I.e. {*} fails and {$x} where $x need to have {*}$x fails, but
#     "$x" does the right thing.
# 3.) more than one command is ok but they should be seperated in 1 of 2 ways:
#     if the script is in quotes, put semicolons between them. If the script is
#     protected, i.e. { script } just put in new lines.

# In short, enclose the script in quotes, avoid {*} (not needed) and seperate
# commands with ;'s.


# proc Try { tryscript excuse alsoPrintErrorInfo {async 0} } {}
proc Try {tryscript args} {
  global glob
  frputs #2 tryscript args
  if {[lindex $args 2] == 1 || "-a" in $args} {
    # If this is an exec command we use "&" for async
    # If not we will use "after 0" to launch the command
    # In this case we also keep track of how many we have out
    
    if {[string match "*exec*" $tryscript] &&\
	   [string index $tryscript end] != "&"} {
      append tryscript " &" 
    } else {
      # A lot of sweat went into the following line....
      set deRcmd [uplevel subst  [list [list {*}$tryscript]]]
      frputs deRcmd
      set deRcmd [regsub -all {{;}} $deRcmd {;}]
      frputs deRcmd tryscript
      after 0 [list tendAsync $deRcmd $args]
      return 0
    }
  }
  set tryscript [regsub -all {{;}} $tryscript {;}]
  if {[catch {uplevel $tryscript} outp] == 0} {return 0}
  frputs outp ::errorInfo
  return [TryReportErrors $outp $args]
}

proc TryReportErrors {outp arg} {
  
  if {$::glob(abortcmd) > 0} {
    LogSilent "Ignoring error: $::errorInfo"
    return 0
  }

  # This is a really ugly hack, but I don't care... I can't 
  # see another way around this. Email me if you got a solution.
  # (Problem shows up in Linux when unarchiving .tar.gz files 
  # and the error is completely harmless)

  if {$outp == ""} {
    return 0
  }
  if {[string match {*Broken pip*gunzip*} $outp] ||\
	  [string match {child killed: write on pipe with no readers} $outp]} {
    Log "Ignoring error: $outp"
    return 0
  }
  # Time to decode the rest of the args
  # We know there is no "async flag" left... but we share so...
  set excuse {}
  set index -1
  set np 0
  foreach val $arg {
    incr index
    switch -exact [string range $val 0 1] {
      -s {set excuse [string range $val 2 end]}
      1  -
      -q {incr np}
      -a -
      0  {}
      default {
	if {$index == 0} {set excuse $val}
      }
    }
  }
  
  if {!$np} {
    if {$excuse != ""} {
      PopError "$excuse\n$outp"
    } else {
      PopError "$outp"
    }
  } else {
    if {$excuse != ""} {
      PopError "$excuse"
    }
  }

  return 1
}

proc StartTerm { inst } {
  global glob config
  set dir $glob($inst,pwd)
  Try {cd $dir; eval exec [format $config(cmd,term) $dir] & }
}



proc getOldNewVersions {} {
  global glob
  set r [catch {source $glob(conf_dir)/version} out]
  if {$r} {
    set version 21.07.15.00
  }
  # This is here to take care of old format version strings...
  if {![string match {[0-9][0-9].[0-9][0-9].[0-9][0-9].[0-9][0-9]} $version]} {
    set version 00.00.00.00
  }
  # puts "[list $version $glob(version)] >$version $glob(version)"
  
  # take the "."s out... resolve to day only
  set oldv [string range [regsub -all {\.} $version {} ] 0 end-2]
  set newv [string range [regsub -all {\.} $glob(Sversion) {} ] 0 end-2]
  return [list $oldv $newv]
}

# This returns true if this is the first run of a new rev.
proc ShowRev { } {
  global glob env
  lassign [getOldNewVersions] oldv newv
  if {$newv > $oldv} {
    # while {[info exists ::holdForMount] && [incr failsafe] < 1000} {
    #   incr ::foobarx
    #   realWaitForIdle
    # }
    About
    #  show the history on a new rev
    set r [catch {
      set fid [open $glob(conf_dir)/version w]
      puts $fid "set version $glob(Sversion)"
      close $fid
    }]
    if {$r} {
      lappend ::mess [_ "Cannot create %s/version" $glob(conf_dir)]
    }
    return 1
  }
  return 0
}


# This logs to the log window and the top status bar.
proc Log { text } {
  global glob
  # Clean any returns from the string (usually from expect)
  set text [regsub -all {\r} $text {}]
    #if {![info exist glob(init_done)] || $glob(init_done)} {
    # # This is early start up land. We want to record who called
    # # for the previous 2 frames
    # foreach frame {-1 -2} {
    #   array set in [info frame $frame]
    #   append info #[expr {-$frame}] $in(proc) ( $in(line) )
    # }
    # set text "$info $text"
    #}
  # It is possible to get here before we are up and ready
  # lets cache such lines and do them later
  lappend ::DeferedLog $text
  if {[info exist glob(init_done)] && $glob(init_done)} {
    foreach mes $::DeferedLog {
      LogStatusOnly $mes
      LogSilent $mes
    }
    unset ::DeferedLog
  }
}
set glob(statusProgress) ""
# This logs only to the top window status frame
proc LogStatusOnly { text args } {
  global glob
  upvar #0 glob(statusline) stat glob(statusProgress) progress
  if {[info exists glob(win,top)] && [winfo exists [set w $glob(win,top).status]]} {
    set last {}
    set text [regsub -all {\n|\r} $text { }]
    # set new [string trim [$w cget -text]]
    # frputs text "[string range $new end-2 end] "
    # set stat [string trimright [string range $stat 0 end-[string length $progress]]]
    if {$text in {"U" "."} && [string range $stat end-2 end] == "U ."} {return}
    
    append stat " $text"
    set len [string length $stat]
    lassign [split [winfo geo $w] x+] width
    set fsize [font measure [$w cget -font] -displayof $w "O"]
    set over [expr {$len - ($width / $fsize)}]
    if {$over >= 0} {
      set stat [string range $stat $over+1 end]
    }
    $w tag configure hl -background [$w cget -selectbackground]
    $w configure -state normal
    $w delete 0.0 end
    $w insert insert $stat
    if {[string is integer -strict [set arg [lindex $args 0]]] ||\
	    ($arg == {} && [set arg $progress] != {})} {
      if {$arg < 0 || $arg > 100} {
	set progress {}
      } else {
	set argLn [string length $arg]
	set progress $arg
	set statDisplay $stat
	append statDisplay  [string repeat { } [expr {-$over}]]
	set statDisplay "[string range $statDisplay $argLn+2 end] $arg%"
	set chToHlTo [expr {($arg * [string length $statDisplay]) / 100 }]
	$w delete 0.0 end
	$w insert insert [string range $statDisplay 0 $chToHlTo] hl
	$w insert insert [string range $statDisplay $chToHlTo+1 end]
	
	frputs #2 over text arg len chToHlTo "[string length $statDisplay] "
      }
    }
    $w configure -state disabled
  } elseif {$text != {}} {
    PopError $text
  }
}

proc ViewLog {} {
  global glob env
  # Not sure it makes sense to provide a file name here.
  # It, most likely, does not exist.
  lappend glob(log_window) [ViewString [_ "Log"] glob(log) ReadOnly 1]
}

# The following writes to the log text window
proc LogSilent { text } {
  global glob config
  frputs #3 #2 #1 "LOG: " text 
  set glob(log)  "$glob(log)---[Time]---\" $text\"\n"
  set len [string length $glob(log)]
  if { $len > $config(logsize) } {
    set glob(log) \
	"...[string range $glob(log)\
         [expr $len - (($config(logsize) * 4) / 5)] end]"
  }
  if {[info exists glob(log_window)] } {
    set new {}
    foreach w $glob(log_window) {
      if {[catch {wm attributes $w} ] == 0} {
	$w.text insert end "---[Time]---\" $text\"\n"
	$w.text see end
	lappend new $w
	$w.text edit reset
      }
    }
    set glob(log_window) $new
  }
}


proc CleanUp { {ret 0}} {
  global env config glob
  wm withdraw .
  Clean
  catch {file delete -force -- $glob(tmpdir)}
  if { $ret } { 
    puts [_ "FileRunner: aborting (return code %s)" $ret]
    # bgerror $ret
    # while {1} {update}
 }
  # save history to disk
  set r [catch {
    set fid [open $glob(conf_dir)/history w]
    puts $fid $glob(history)
    close $fid
  } out]
  if {$r} {
    puts [_ "FileRunner: Can't save directory history to disk: %s" $out]
  }
  if { $config(save_conf_at_exit) && !$r && !$ret } {
    SaveConfig
  }
  exit $ret
}

proc Time {{fmt $config(dateformat)}} {
  global config
  set fmt [subst $fmt]
  if {$fmt == "yymmdd"} {
    return "[clock format [clock seconds] -format %y%m%d\ %R]"
  } elseif {$fmt == "ddmmyy" } {
    return "[clock format [clock seconds] -format %d%m%y\ %R]"
  } else {
    return "[clock format [clock seconds] -format $fmt]"
  }
}

proc TimeUpdater {} {
  global glob config
  $glob(win,top).menu_frame.clock configure -text "[Time $config(dateformatTop)]  "
  after [expr {60 - [clock seconds] % 60}]000 TimeUpdater
}

proc ClearWatch { inst newdir } {
  global glob config
  if { $glob(inotify_flags) != {} } {
    if {$glob(notify,$inst) != $newdir} {
      if {$glob(notify,left) != $glob(notify,right) } {
	if {[catch {$glob(notify,watchname) remove $glob(notify,$inst)} out] != 0} {
	  frputs  out
	}
      }
      set glob(notify,$inst) $newdir
      if {$glob(notify,left) != $glob(notify,right) } {
	set notifyFlags  [expr { ! [NonLocalDir $newdir] ? $config(inotify_flags) :\
				     $config(inotify_nlflags)}] 
	if {$notifyFlags != {} && \
		[catch {$glob(notify,watchname) add $glob(notify,$inst)\
			      $notifyFlags} out] == 0 } {
	  set glob(notify_id,$inst) $out
	} elseif {$notifyFlags != {} } {
	  frputs out
	}
      } else {
	set glob(notify_id,$inst) $glob(notify_id,[Opposite $inst])
      }
    }
  }
}
#

set glob(capture_dir,left) [set glob(capture_pwd,left) ""]
set glob(capture_dir,right) [set glob(capture_pwd,right) ""]


proc ClearCherryPicker { inst } {
  global glob
  set glob(n_file_cache,$inst) {}
  set glob(n_files,$inst) {}
}

proc WakeListUpdater { args } {
  global glob
  if {$glob(enableautoupdate) != 0} {
    trace remove variable glob(enableautoupdate) write WakeListUpdater
    ListUpdater
  }
}

proc ListUpdater {} {
  global glob config
  set did 0
  if {$glob(enableautoupdate)} {
    LogStatusOnly "U"
    set glob(enableautoupdate) 0
    foreach inst {left right} {
      if { ! [IsVFS $glob(${inst},pwd)] } {
        set r [catch { set mtime [file mtime $glob($inst,pwd)] }]
        if {!$r} {
          if {$mtime != $glob($inst,lastmtime)} {
	    updateInPlace $inst
 	    set did 1
          }
        }
      }
    }
    set glob(enableautoupdate) 1

    LogStatusOnly "."  
  } else {
    trace remove variable glob(enableautoupdate) write WakeListUpdater
    trace add    variable glob(enableautoupdate) write WakeListUpdater
  }
  if {$config(autoupdate)} {
    after cancel ListUpdater
  }
  return $did
}

proc StartUpdaters {} {
  global glob config
  TimeUpdater
  foreach lr {left right} {
    set glob($lr,lastmtime) 0
    set glob($lr,lasttime) 0
    set glob(inotify_after,$lr) {}
  }
  if {$config(autoupdate)} {
    # first update right away.
    after [expr $config(autoupdate) * 1000] ListUpdater
  }
}

proc frgrab { w } {
  for {set i 0} {$i < 10} {incr i} {
    set r [catch {grab $w} out]
    if {!$r} { return }
    after 50
  }
  if {$r} {
    LogStatusOnly "$out"
  }
}

proc CheckCmdLineArgs { } {
  # returns 1 if iconified by start up.  Always 
  # iconified, unless debuging...
  global argv glob
  set ops {}
  foreach db {db -db tkcon -tkcon -iconified early -early} {
    if {[set i [lsearch -exact $argv $db]] != -1} {
      set argv [concat [lrange $argv 0 [expr $i - 1]] \
		    [lrange $argv [expr $i + 1] end]]
      if {[string index $db 0] == "-"} {
	set ops [string replace $db 0 0]
      }
      lappend ops $db
    }
  }
  if {"iconified" in $ops} {
    wm "iconfify" .
  }
  if {"early" in $ops} {
    startTkDebug $ops
  } else {
    set glob(debug) 0
    setupDebug 0
  }
  return $ops
}

proc startTkDebug {ops} {
  global glob
  set glob(debug) 0
  if {"db" in $ops} {
    set glob(debug) 1
  }
  wm state . "normal"
  setupDebug $glob(debug)
  expr {"tkcon" in $ops && [catch {package require tkconrc;tkcon show}]}
  #realWaitForIdle
}

proc ViewBatchList {} {
  global glob
  set tmp [join $glob(batchlist) \n]
  ViewString {VFS Batch List} tmp
}


proc AddToBatchList { inst } {
  global glob
  foreach sel [$glob(listbox,$inst).file curselection] {
    set elem [lindex $glob($inst,filelist) $sel]
    lassign $elem {*}$glob(fListEl)
    switch $type {
      fl -
      fn {
        set item [list $glob($inst,pwd)/$file $size]
        lappend glob(batchlist) $item
      }
      default {
        PopError [_ "You can only add VFS files to the batch"]
        return
      }
    }  
  }
}


proc CheckOwner { file } { 
  if {! [file exists $file]} {
    return 1
  }
  return [file owned $file]
}
#trace add variable glob(select_cur_lr) write TraceIt
proc TraceIt { a b c } {
  global glob
  puts " $a element $b set to $glob($b)"
}
proc dumpStartTimes {} {
  # if {! $glob(debug)} {return}
  set frputsOn $::frputs::on
  setupDebug 1
  frputs "All times in milliseconds "
  frputs " Incr  RunTotal "
  foreach ent $::startTimes {
    lassign $ent time mess
    if {![info exists st]} {
      set fr $time
      set st $time
    }
    frputs "[format {%5s %5s %s} [expr {$time - $st}] [expr {$time - $fr}]  $mess] "
    set st $time
  }
  frputs "[expr {$time - $fr}] Total start time "
  setupDebug $frputsOn
  return $frputsOn
}

# ################################: STARTUP #########################
#
#####################################################################
#      This is the boiler plate code ver <20180124.1808.36>         #
#####################################################################
# This first script (the command 'unload_tclIndex') and the         #
# immediately following calls to it unload any files loaded by      #
# references to env(TCLLIBPATH).  This is done mostly to prevent    #
# shipping an application that depends on local files, AND so       #
# we/you get the right code when debugging. You may not care about  #
# this or may depend on such in which case you should code a 0 in   #
# the following if statement.                                       #
#                                                                   #
if {1} {                                                           ;#
  # This code will execute on loading/sourceing and should be in    #
  # the main source of your code. The command 'unload_tclIndex',    #
  # given the path to a tclIndex, attempts to source it, and, if    #
  # successful removes all traces of any proc indexed in it unless  #
  # it has already been called. This is why this code should be in  #
  # the first script loaded and before any other code executed in   #
  # that script. We assume that the caller has already removed it   #
  # from "auto_path"                                                #
  #                                                                 #
  proc unload_tclIndex {dir} {                                     ;#
    # The following test depends on un-documented variables in the  #
    # Tcl source and as such is at risk. Good through Tcl 8.6.6     #
    # Caution: Tcl 8.6.6 moves auto_oldpath to ::tcl, but prior     #
    # versions AND TclX have it as a global. If the given dir is    #
    # not in auto_oldpath, it means this dirs index has not been    #
    # sourced by the system yet, so we need do no more.             #
    variable ::tcl::auto_oldpath                                   ;#
    if {(![info exists auto_oldpath] || $dir ni $auto_oldpath) &&
	(![info exist ::auto_oldpath] || $dir ni $::auto_oldpath)} {
      return                                                       ;#
    }                                                              ;# 
    #                                                               #
    # The following 'source' command will create a local auto_index #
    # which we then use to look at the global auto_index.           #
    # 
    if {[catch {source [file join $dir tclIndex]}] != 0} {return}  ;#
    foreach {name script} [array get auto_index] {                 ;#
       if {[info exists ::auto_index($name)] &&\
	       $::auto_index($name) == $script} {                  ;#
	 unset ::auto_index($name)                                 ;#
	 # There is no way to know if this has been called already  #
	 # since it could be part of the core system. We MUST not   #
	 # rename it away. We know that a TCLLIBPATH set up a       #
	 # version, but NOT if the current program will set up its  #
	 # own. If it does not, a rename here would loose that      #
	 # functionality.                                           #
      }                                                            ;#
    }                                                              ;#
  }                                                                ;#
  # This script removes any special local dirs from auto_path and   #
  # calls the above to scrub any commands already loaded.           #
  #                                                                 #
  if {[info exists env(TCLLIBPATH)] } {                            ;#
    # We want to keep these even if in env(TCLLIBPATH)              #
    set notThese [list $::tcl_library [file dir $::tcl_library]]   ;#
    if {[info exists ::tcl_pkgPath]} {                             ;#
      lappend notThese {*}$::tcl_pkgPath                           ;#
    }                                                              ;#
    foreach path $env(TCLLIBPATH) {                                ;#
      if {$path in $notThese} {continue}                           ;#
      set indx [lsearch -exact $auto_path $path]                   ;#
      if {$indx != -1} {                                           ;#
	set auto_path [lreplace $auto_path $indx $indx]            ;#
	unload_tclIndex $path                                      ;# 
      }                                                            ;#
    }                                                              ;#
  }                                                                ;#
}   ;# End of enabling if.                                          #
#                                                                   #
# This bit of code figures out where the rest of the routines are   #  
# on the assumption that they are in the same directory as the      #
# initial code file. If 'setIt' is 1 or not coded auto_path is set  #
# in any case the resulting dir is returned to the caller. If this  #
# is in a 'freewrap' package, the windows leading C:/ (well really  #
# <drive letter>:/) is removed as required by Wrap code for windows.#
# To function correctly this code MUST be called prior to completion#
# of the 'source' command that brings it in. Also, since it is used #
# to set up auto_path it can not be auto loaded.  It may be sourced,#
# but again the from where issue is there. Therefor it is best if   #
# this is just merger with the using code in a location prior to its#
# call.                                                             #
#                                                                   #
proc cSetAutoPath {new} {                                          ;#
  if {$new ni $::auto_path} {lappend ::auto_path $new}             ;#
}                                                                  ;# 
#                                                                   #
proc setAutoPath {{setIt 1}} {                                     ;#
  set it [info script]                                             ;#
  set it [expr {$it == "" ? "[pwd]/*" : $it}]                      ;#
  set it [file dir [file dir [file norm $it/*]]]                   ;#
  # Wrap code requires we not have the drive letter...              #
  if {[namespace exists freewrap]} {                               ;#
    set it [regsub {^[a-zA-Z]:/} $it {/}]                          ;#
  }                                                                ;#
  if {$setIt} {                                                    ;#
    cSetAutoPath $it                                               ;#
  }                                                                ;#
  return $it                                                       ;#
}                                                                  ;#
#####################################################################
#                   End of boiler plate code                        #
#####################################################################

# A message that starts with "-" indicates a new output function
# which will be used once before reverting back to "PopWarn"

proc doDeferedMessages {args} {
  if {$args != {}} {
    set ::mess [concat $::mess {*}$args]
  }
  lappend ::save {*}$::mess
  set fun "PopWarn"
  while {$::mess != {}} {
    set ::mess [lassign $::mess ms]
    if {[string index $ms 0] == "-"} {
      set fun [string range $ms 1 end]
      continue
    }
    if {[set ms [string trim [regsub -all {\{|\}} $ms {}]]] == {}} {
      continue
    }
    eval [list {*}$fun $ms]
    set fun "PopWarn"
  }
}


proc FindLibfr {} {
  global glob config env argv argv0 auto_path
  # clean up argv0 (it is used in Clone and possibly for run as root)
  set ::argv0 [file norm $::argv0]
  set tail [file tail [file dir [file norm [info script]/*]]]
  if {$tail == "" } {
    set tail [expr {$::tcl_platform(platform) == "windows" ? "fr.exe" : "fr"}]
  }
  set possible [pwd]

  lappend possible [set lc [setAutoPath 0]]
  set success 0
  # puts "searching $possible for $tail from [info script] autopath returns $lc"
  foreach testfile [lreverse $possible]  {
    #    puts "testing $testfile"
    if { [file exists $testfile/$tail]  == 1 } {
      lappend ::auto_path [set glob(lib_fr) $testfile]
      set success 1
      break
    }
  }
  if { $success != 1} {
    puts [_ "Can not find fr library. Looked in %s We quit!" \
	      $possible]
    # Don't use 'CleanUp' here. Too early in spin up.
    exit 1
  }
  # just for grins...
  if {$lc != $testfile} {
    puts "Chose $testfile over $lc"
  }
  #set glob(catch) [glob -nocomplain $glob(lib_fr)/packages/*]

  foreach path [list $glob(lib_fr)/packages $glob(lib_fr)/packagesStd\
		    [set glob(conf_dir) [file normalize [findFrDir]]]] {
    cSetAutoPath $path
  }

  # From here on we can use all our normal error code.  We may not 
  # have all the color, but it will work...
  # The wm command here moves the following question to the center 
  #(or there about) of the screen rather that having it get lost on an edge.
  wm geometry . +500+500
  # bring in the global config stuff
  if {[file readable $glob(lib_fr)/config]} {
    #    puts "sourcing $glob(lib_fr)/config"
    set r [catch {source $glob(lib_fr)/config} out]
    if {$r} {
      PopInfo [_ "Reading system wide configuration from \
           %s:\n%s" $glob(lib_fr)/config $out]
    }
  }
  if { ! [info exists glob(doclib_fr)] } {
    foreach fhf [list $glob(lib_fr) $glob(lib_fr)/doc] {
      #puts "Trying $fhf/HISTORY [file isfile $fhf/HISTORY]"
      if {[file isfile $fhf/HISTORY]} {
	set  glob(doclib_fr) $fhf
	file lstat $fhf/HISTORY farry
	if {$farry(type) == "link"} {
	  set glob(doclib_fr) \
	    [file dirname [file normalize [file readlink $fhf/HISTORY]]]
	} 
	break
      }
    }
    if {! [info exists glob(doclib_fr)] } {
	lappend ::mess [_ "Can not find document directory. Looked here\n%s\n\
                 %s\
                \nHelp menu items will not exist..." \
			    $glob(lib_fr) $glob(lib_fr)/doc]
      set glob(doclib_fr) {}
    }
  } else {
    if {![file readable $glob(doclib_fr)/HISTORY]} {
      lappend ::mess [_ "Document file %s is not readable \
              \n(possibly does not exist)\
              \nHelp menu \"Histroy\" will not exist" $glob(doclib_fr)/HISTORY]
    }
  }
}
# This allows re-sourceing of fr
if {[info exists glob(init_done)] && $glob(init_done)} {
  return
}
# What follows is (or should be) all initialization of globals
# followed by building the main window(s).
# Global package requirements...
# We require Tk for MS windows where we hope the package starts with
# tclsh and fr.tcl which sources this file (fr). It is important
# to have tclsh as that is how we get stdout pipes to work correctly.

# This bit removes any special local dirs from auto_path. This is done mostly
# to prevent shipping a filerunner that depends on local files...And so we get
# the right code when debugging. MUST BE BEFORE FIRST PROC.
# if {[info exists env(TCLLIBPATH)] } {
#   foreach path $env(TCLLIBPATH) {
#     set indx [lsearch -exact $auto_path $path]
#     if {$indx != -1} {
#       set auto_path [lreplace $auto_path $indx $indx]
#       # puts "removed $path from auto_path"
#     }
#   }
#   # Now clear any auto_index entries added from TCLLIBPATH
#   auto_reset
# }

# some systems (OSX) don't set up the DISPLAY env var

if {![info exists env(DISPLAY)] && $::tcl_platform(platform) == "unix"} {
  set env(DISPLAY) ":0.0"
}

startProc "Begin start up"
set mess {}
package require Tk
package require msgcat

startProc "After Tk start up"

# not sure of what the 'subst' options should be (-nobackslashes or nil)
set stOps {}
# Here are a couple of UTF-8 characters that look like "/" and "\"
# but aren't. We use in places we want the look with out the effect.
set optionalSlash     [format %c 0x0338]
set optionalBackSlash [format %c 0x2216]
# this list is used to find elements in the file lists
set glob(fListEl) [list sortval file type size mtime mode usergroup \
		       link nlink atime ctime]

# command button labels are also use to find the command in this
# structure.  We localize after we decide to use a button...
#
# The middle button sublist (one for each button) has the following entries;
# 0  The displayed name
# 1  The command to call
# 2  For keyboard mode, the key that invokes this command 
# 3  For keyboard mode, the index of the char in the cmd to underline (obsolete, not used)
# 4  The message to display for the command in "tips" or "ballon help" mode
#
# Used keyboard mode chars:
# a Arc b NA c Copy d Delete e Edit f Diff g NA h Chmod i Iconify j-n NA
# o open p Packq Q-Edit r Rename s Softlink t NA u unArc v View w NA x Exit
# y-z NA

set glob(cmds,list)  { 
  { {Copy}    CmdCopy c 0 \
	{[_b "Copy selected file(s) to other dir. if\
          the selected file is a dir, recursively copies\
          all files in the tree under that dir." ] }} 
  { {CopyAs}  CmdCopyAs "" 0 \
	{[_b "Copy selected file(s) to other dir with new name." ]} } 
  { {Delete}  CmdDelete d 0 {[_b "Delete selected file(s)" ]} }
  { {Move}    CmdMove m 0 {[_b "Move selected file(s) to other dir." ]} }
  { {MoveAs}  CmdMoveAs "" 0 \
	{[_b "Move selected file(s), to other dir with new name(s)." ]}}
  { {Rename}  CmdRename r 0 \
	{[_b "Rename selected file(s). Can cause move." ]} }
  { {MkDir}   CmdMakeDir "" 0 \
	{[_b "Create new dir from modified dir line. If\
           no modified dir line, prompts with left dir as starter." ]} } 
  { {S-Link}  CmdSoftLink s 0 {[_b "Create a symbolic link\
           to selected file(s) in other dir." ]} }
  { {S-LnAs}  CmdSoftLinkAs "" 0 {[_b "Create a symbolic link to\
           selected file(s) in other dir.\
           prompting for a new name for each file." ]} } 
  { {Chmod}   CmdChmod h 1 \
	{[_b "Change the mode flags for selected file(s)." ]} } 
  { {View}    CmdView v 0 \
	{[_b "For dirs, go to the selected dir, for\
           files, execute the %s rule selected program\
           with the selected file." "View" ]} }
  {{ViewAsTx} CmdViewAsText "" 0 \
	{[_b "Sends selected files directly to a View\
           window regardless of file type or extension." ]} }
  { {Open}    CmdOpen o 0 \
	{[_b "For dirs, go to the selected dir, for\
           files, execute the %s rule selected program\
           with the selected file." "Open" ]} }
  { {Run}     CmdRunCmd "" 0 \
	{[_b "Run a program passing the selected file(s)." ]} }
  { {Edit}    CmdEdit e 0 \
	{[_b "Pass the selected file(s) to the\
           user definded editor." ]} } 
  { {Q-Edit}  CmdQEdit q 0 \
	{[_b "Pass the selected file(s) to the\
            internal (tcl) editor." ]} } 
  { {Arc}     CmdArc a 0 \
	{[_b "Pass the selected file to the rule\
           defined archive program." ]} } 
  { {UnArc}   CmdUnArc u 0 \
	{[_b "Pass the selected file to the rule\
           defined unarchive program." ]} } 
  { {UnPack}  CmdUnPack p 2 \
	{[_b "Pass the selected file to the rule defined\
           unpack/uncompress program." ]} } 
  { {ForEach} CmdForEach "" 0 \
	{[_b "Run a selected (prompted for) program on\
          selected file(s)." ]} } 
  { {Print}   CmdPrint "" 0 \
	{[_b "Pass the selected files to the user\
         defined print program." ]} } 
  { {Diff}    CmdDiff f 2 \
	{[_b "Pass the last two selected files or dirs\
         (may both be in the same dir) to the user\
         defined diff program." ]} } 
  {{Rsync copy} CmdRsync "" 0 \
	{[_b "Rsync copies files as does copy but if one\
            directory is not local (nfs cifs or vfs)\
            rsync will be called with the host address such\
            that the transfer is using rsync's private connection\
            to the remote host." ]}}
  { {Select} CmdSelect "" 0 \
	{[_b "After you enter a pattern  in\
          one of the dir lines, selects\
          all matching files." ]} } 
  { {HardLink} CmdHardlnk "" 0 \
	 {[_b "Creates hard links in the opposite dir of\
           selected files.  If the selection is a  dir\
           recursively desends the dir creating hard links\
           for each file. Uses a user selected program." ]}}
  {  {HardLinkAs} CmdHardlnkAs "" 0 \
	 {[_b "Creates hard links, with a new name, in the opposite dir  of\
           selected files. If the selection is a dir\
           recursively desends the dir creating hard links\
           for each file. Uses a user selected program." ]}}
    {  {Mount VFS} CmdMount "" 0 \
	 {[_b "Mounts the selected file as a virtual file\
                system (VFS)." ]} }
  {  {UMount VFS} CmdUMount "" 0 \
	 {[_b "Un Mounts the selected file(s) as a virtual file\
                system (VFS)." ]} }
  {  {Iconify} {wm iconify .} "i" 0 {[_b "Iconify filerunner" ]} }
  {  {Exit} CleanUp "x" 0 {[_b "Exit filerunner (same as \"File-> Quit\"" ]}}
}

# We want the doProt family to be re-entrant so we don't lose the cursor/
# update status...
#
set DoProtLevel 0
set MaxDoProtLevel 0
set DoProtProc {}

set DNlist {}

set glob(asyncCount) 0
set glob(mbutton) 0
set glob(start_path) [pwd]
set glob(ftp,debug) 0
set glob(userMenuList) {}
#puts "about to do cmdline args"
FindLibfr
set startOps [CheckCmdLineArgs]
startProc "After cmd line args"
# The following code is put into a start proc so that it is easy to
# put it in a Catch.

proc startFr {} {
  global startTimes glob Copyright config mess startOps
  
  #puts "icon is $icon"
  source $glob(lib_fr)/frVersion.tcl
  regsub {20([0-9][0-9])([0-9][0-9])([0-9][0-9])\.([0-9][0-9]).+} \
      $glob(version) {\1.\2.\3.\4} glob(Sversion)
  set glob(displayVersion) $glob(Sversion)[expr {[namespace exists freewrap] ? "w" : ""}]
  startProc "After finding libary"
  set Copyright [format "Copyright:
© 2010-%s Tom Turkey
© 1996-1999 Henrik Harmsen" [string range $glob(version) 0 3]]

  # setupDebug $glob(debug)
  startProc "After debug setup"

  #puts "about to do set platform"

  set glob(notify,Available) 0



  set glob(inotify_flags) {}

  #puts "set up inotify"
  set glob(cygwin) {}
  if {[namespace exists freewrap]} {
    uplevel 0 source $glob(lib_fr)/packageLinks.tcl
  }

  CheckConfigDir
  startProc "After check config dir"

  ###################################: Load platform code #######################
  package require $::tcl_platform(platform)

  set glob(notify,left) [set glob(notify,right) ""]
  set glob(init_done) 0

  #puts "about to do home"

  startProc "After platform setup"
  package require balloonhelp

  # Now the user commands and config stuff

  set config(usercommands) ""
  if { [file exists $glob(conf_dir)/cmds ] } {
    # This allows "cmds" to source other files in the same dir without
    # knowing where it is.
    cd $glob(conf_dir)
    set r [catch { source cmds } out]
    if { $r != 0 } {
      lappend ::mess\
	  [_ "Error loading code from %s/cmds:\n\n%s" $glob(conf_dir) $out]
      # Lets treat this as non-fatal...
    } else {
      Log [_ "Loaded \"%s\"" [pwd]/cmds]
    }
  } else {
    Log [_ "File \"%s\" (user extensions - see \"Help -> User's Guide\") not found." $glob(conf_dir)/cmds]
  }
  startProc "After user commands setup"

  set glob(left,listhead) ""
  set glob(right,listhead) ""
  set glob(panelsLocked) 1
  set glob(selected) left
  set glob(localCmds) [list cd history view type]
  startProc "After fast check box setup"
  ::VFSvars::VFS_InvalidateCache
  InitConfig
  buildTbarIcon
  # lh [array get glob gui*]
  startProc "After init config setup"
  namespace eval ::autoscroll {proc autoscroll {args} {}}
  set pak [catch {
    package require autoscroll
    package require cursor
    ::cursor::propagate . {}
  }]
  # if {[catch {package require extrafont} er] != 0} {
  #   lappend ::mess $er
  # }
  ShowWindow
  startProc "After main window build"
  # initialize the password locker (moved to config.tcl)
  # ::pwLocker::init ::config(passwordLocker) \
      #     [list encrypt $env(USER)] \
      #     [list decrypt $env(USER)] \
      #     [list SaveConfig]

  # frputs config(passwordLocker) 
  lappend mess [ReadConfig]
  startProc "After config file read [realWaitForIdle]"
  expr {"iconified" ni $startOps && [wm deiconify .] == {}}
  startProc "After main window deiconify [realWaitForIdle]"
  ConfigPwd
   # Wait for the window to materialize
  # startProc "Before main not viewable check"
  # while {"iconified" ni $startOps && [incr failsafe] < 100 &&\
  #            [winfo viewable $glob(win,left).frame_listb.top.c.file] } {
  #   #wm state . "normal"
  #   realWaitForIdle
  #   startProc  "Waiting for viewable [realWaitForIdle] "
  # }
  # startProc "After main viewable OFFICIAL START TIME"
  StartUpdaters
  startProc "After updaters started Wait for idle [realWaitForIdle] "
  Try {setUpInotify} -a
  if {!$::MSW && !$config(manualMonitors)} {
    Try {::displays::init} -a
  }

  # Check if we have a decent kill function...
  set notice [killInit]
  if {$notice != {}} {
    if {![file exists $glob(conf_dir)/killNotice.txt]} {
      lappend ::mess "-PopInfo" $notice
      # PopInfo $notice
      set r [catch {open $glob(conf_dir)/killNotice.txt w} fid]
      if {$r != 0} {
	lappend ::mess "-PopInfo" \
	    "Error opening $glob(conf_dir)/killNotice.txt: $fid" 
	# PopInfo 
      } else {
	puts $fid $notice
	close $fid
      }
    }
  }
  if {[info command sleep] == {}} {proc sleep {sec} {exec sleep $sec}}
  startProc "After inotify, kill set up"
  
  # don't let some problem here hang the boot
  # incr ::holdForMount
  # was after 0
  if {[catch CmdMountOnStart me] != 0} {
    lappend ::mess "Error setting up old VFS mounts: \n$me $::errorInfo" ;
  } ;
  # unset -nocomplain ::holdForMount ;
  startProc "After Mount on Start" ;
  doDeferedMessages ;
  realWaitForIdle ;
  if {[ShowRev] && [file exist $glob(doclib_fr)/HISTORY]} {
    lappend mess "-ViewText" $glob(doclib_fr)/HISTORY
  }
  startProc "Calling startTkDebug"
  doDeferedMessages 

  # dumpStartTimes
  startTkDebug $::startOps
  startProc "After start debug"
  unset ::startOps
  set glob(init_done) 1
  Log [_ "Welcome to FileRunner v%s.\
        %s" $glob(displayVersion) $Copyright]
  startProc "After welcome"


  # Here we have set up that can wait
  realWaitForIdle
  Try {setUpInotify} -a
  if {!$::MSW && !$config(manualMonitors)} {
    Try {::displays::init} -a
  }
  Try {cleanTmpFiles} -a
  #finishButtonScroll
  Try finishButtonScroll -a
  startProc "After finishButtonScroll"
}

# need to catch this before it goes away
set glob(program) [info script]

proc startFilerunner {} {
  set r [catch {startFr} er]
   UdoWhatEver
  # This will make our window topmost, but allows it to move down.
  after 0 {wm attributes . -topmost 1 ; wm attributes . -topmost 0}
  if {$::tcl_platform(os) != "Darwin"} {
    after 0 {package require textmenu}
  }
  if {$r != 0} {
    # oops, bad news.  See if we have tkcon loaded.
    after 0 [list startTkDebug {tkcon db}]
    set ::errortmp $::errorInfo
    set fid [open FrError.log w]
    puts $fid "Stack trace: $::errortmp"
    close $fid
    puts "Error $er found in start up. \
        \nFor more info try adding 'db tkcon early' to run command."
    puts "Attempting to start tkcon"
    realWaitForIdle
    realWaitForIdle
    # We want to wait for tkcon to finish its set up
    while {![info exists ::tkcon::CPS]} {
      update
      puts "waiting [realWaitForIdle]"
    }
    
    puts "Stack trace: $::errortmp"
  }
}
after 0 startFilerunner
startProc "Reached end of start"
# unset mess

# if {$mess != {}} {
#     smart_dialog .amess . {Message...} [list {} $mess] 0 0 {}
# }
return
