#!/usr/bin/wish
# -*- tcl -*-


set glob(version) "<20140618.1002.17>"
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(version)
#regsub -all {0([0-9])}  $glob(version) {\1} glob(version)

package require msgcat
proc _ {s {p1 ""} {p2 ""} {p3 ""} {p4 ""} } {
  return [::msgcat::mc $s $p1 $p2 $p3 $p4]};
proc _b {s {p1 ""} {p2 ""} {p3 ""} } {return [::msgcat::mc $s $p1 $p2 $p3]};

proc bgerror {err} {
  global errorInfo env glob tcl_patchLevel tk_patchLevel ignor_error_flag
  if {$glob(abortcmd) == 1} {
    # note it and ignor it...
    frputs "Ignoring error during abort: $errorInfo"
    LogSilent "Error: during abort, ignoring: $errorInfo"
    return
  }
  if {[info exists ignor_error_flag] } {
    smart_dialog .bgerrorDialog .\
	[_ "no-no"]\
	[list $ignor_error_flag] \
	0 1 [_ "OK"]
    return
  }
  set info $errorInfo
  UnDoProtCmd
  set button [smart_dialog .bgerrorDialog .\
		  [_ "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 4 [list [_ "Exit"] [_ "See Stack Trace"] \
			   [_ "Prepare bugreport"] [_ "Ignor" ]]]
#  puts "$button"
  switch $button {
    3 {return}
    0 {exit 1}
    2 { buildBugReport $err $info}
    1 {
      set ans [smart_dialog .bgerrorTrace . [_ "Stack Trace for Error"]\
		   [list $info ]\
		   -1 3 [list [_ "Exit"] [_ "Prepare bugreport"] [_ "Continue"]]]
      switch $ans {
	0 {exit 1}
	1 {
	  buildBugReport $err $info
	}
      }
    }
  }
  return
}




proc buildBugReport {err info} {
  global glob env
  set r [catch {open $env(HOME)/filerunner_bugreport w} fid]
  if {$r} { 
    smart_dialog .bugrepinfo .\
	[_ "Error"] \
	[list [_ "Can't create file:\n"]\
	     "$env(HOME)/filerunner_bugreport" \
	     [_ "\nto dump bugreport. Error:\n"] \
	     " $fid" ] \
	0 1 [_ "Exit"]
    exit 1
  }
  puts $fid [_ "\nBugreport for FileRunner version %s\
                created %s.\n" $glob(version) [clock format [clock seconds]]] 
  puts $fid [_ "Please fill in/correct the rest of this and send\
               it to %s.\n\n" tom@wildturkeyranch.net]
  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 .\
	   [_ "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 } {
    exit 1
  }
}

proc ShowWindow {} {
  global glob tk_version argv argv0 config env win fast_checkboxes tcl_platform
  
  wm positionfrom . user
  wm sizefrom . ""
  wm title . "FileRunner  v$glob(version)"
#  wm geometry . $config(geometry,main)
  wm protocol . WM_DELETE_WINDOW { CleanUp 0 }
  wm iconname . "FileRunner v$glob(version)"
  wm command . [concat $argv0 $argv]
  wm group . .

  frame .fupper -bd 0
  frame .flower -bd 0
#  puts "$glob(win,top)"
  frame $glob(win,top) -borderwidth 2 -relief raised
  # TOP LEVEL MENU BUTTONS
  set wf [frame $glob(win,top).menu_frame]
  # File menu
  menubutton $wf.file_but -menu $wf.file_but.m -takefocus 0 -text [_ "File"]
  balloonhelp_for $wf.file_but {[_b "Push it to see..." ]}
  # Configuration menu
  menubutton $wf.configuration_but -takefocus 0 \
      -menu $wf.configuration_but.m \
      -text [_ "Configuration"]
  balloonhelp_for $wf.configuration_but {[_b "Push it to see..." ]}
  # Utilities menu
  menubutton $wf.utils_but -takefocus 0 -menu $wf.utils_but.m -text [_ "Utilities"]
  balloonhelp_for $wf.utils_but {[_b "Push it to see..." ]}
  # Help menu
  menubutton $wf.help_but -takefocus 0 -menu $wf.help_but.m -text [_ "Help"] 
  balloonhelp_for $wf.help_but {[_b "Push it to see..." ]}

  # 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 }
  balloonhelp_for $wf.fasync_cmds.abort \
      {[_b "Attempts to abort a running async command" ]}
  # Clone button
  button $wf.fasync_cmds.clone\
      -takefocus 0\
      -borderwidth 1\
      -text [_ "Clone"]\
      -command Clone
  balloonhelp_for $wf.fasync_cmds.clone \
      {[_b "Creats a clone of filerunner in the same dirs as this one." ]}

  # Create FILE menu
  menu $wf.file_but.m -tearoff false\
      -font $config(gui,GuiFont)

  $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 Quit -command { CleanUp 0 }
  # Create CONFIGURATION menu
  set configmenu $wf.configuration_but.m
  menu $configmenu -tearoff false  -font $config(gui,GuiFont)
  $configmenu add command \
      -label {Save Configuration} -command SaveConfig
  $configmenu add command \
      -label {Edit Configuration...} -command ConfigBrowser
  $configmenu add command \
      -label {Reread Configuration} -command {
	ReadConfig;Log [_ "Configuration re-read"]
      }
  $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 {set ::balloon_help::enable $config(balloonhelp)}
  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
  if { $tcl_platform(platform) != "windows" } {
    $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 (FTP)"] -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 [_ "Anonymous FTP"] -variable config(ftp,anonymous) 
  $configmenu add check \
      -label [_ "Use FTP Proxy"] -variable config(ftp,useproxy) 
  $configmenu add separator
  $configmenu add radio \
      -label [_ "ASCII sort"] -variable config(sortoption) \
      -value "-ascii" -command ForceUpdate
  $configmenu add radio \
      -label [_ "Ignore case on sort"] -variable config(sortoption) \
        -value "-nocase" -command ForceUpdate
  $configmenu add radio \
      -label [_ "Dictionary sort"] -variable config(sortoption) \
      -value "-dictionary" -command ForceUpdate

  $configmenu add separator
  $configmenu add radio \
      -label [_ "Sort Dirs First"] -variable config(fileshow,dirs) \
      -value dirsfirst -command ForceUpdate
  $configmenu add radio \
      -label [_ "Sort Dirs Last"] -variable config(fileshow,dirs) \
      -value dirslast -command ForceUpdate
  $configmenu add radio \
      -label [_ "Dirs Mixed"] -variable config(fileshow,dirs) \
      -value mixed -command ForceUpdate
  $configmenu add separator
  $configmenu add radio \
      -label [_ "Sort On Name"] -variable config(fileshow,sort) \
      -value nameonly -command ForceUpdate
  $configmenu add radio \
      -label [_ "Sort On Time"] -variable config(fileshow,sort) \
      -value time -command ForceUpdate
  $configmenu add radio \
      -label [_ "Sort On Reverse Time"] -variable config(fileshow,sort) \
      -value rtime -command ForceUpdate
  $configmenu add radio \
      -label [_ "Sort On Size"] -variable config(fileshow,sort) \
      -value size -command ForceUpdate
  $configmenu 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 "AnchorTearoff ." \
      -title "Color Edit Menu" -font $config(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 List Box Font...} -command "EditFont ListBoxFont"
  $configmenu add command \
      -label {Edit Gui Font...} -command "EditFont GuiFont"
  $configmenu add command \
      -label {Edit Balloon Help Font...} -command "EditFont BalloonHelpFont"
  $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"

  # Create Utilities menu
  menu $wf.utils_but.m -tearoff true \
      -tearoffcommand "AnchorTearoff ." \
      -font $config(gui,GuiFont)
  ButtonAdd $wf.utils_but.m \
      [list {Clean (destroy View windows)}  - {Clean}\
	   {Swap Windows}                   + {DoProtCmd CmdSwapWindows} \
	   {View As Text}                    + {DoProtCmd CmdViewAsText} \
	   {What Is?...}                     + {DoProtCmd CmdWhatIs} \
	   {Select On Contents...}           + {DoProtCmd CmdCSelect} \
	   {Run Command On Selected...}      + {DoProtCmd {CmdRunCmd 0}} \
	   {Run Command On Selected & prior} + {DoProtCmd {CmdRunCmd 1}} \
	   {Check Size Of Selected...}       + {DoProtCmd CmdCheckSize} \
	   {FTP Copy With Resume}            - {DoProtCmd {CmdCopy 1}} \
	   {FTP Copy With Resume/Async}      - \
	   {set glob(async) 1; DoProtCmd {CmdCopy 1}}
       ]
  menu $wf.help_but.m -tearoff false\
      -font $config(gui,GuiFont) -postcommand CreateHelpMenu
  if {0} {  # Create Help menu
  $wf.help_but.m add command \
      -label [_ "QuickStart" ] \
      -command   { ViewText /usr/share/doc/filerunner/QuickStart.txt }
  $wf.help_but.m add command \
      -label [_ "User's Guide" ]\
       -command { ViewText /usr/share/doc/filerunner/Users_Guide.txt }
  $wf.help_but.m add command \
      -label [_ "Copying"]  -command { ViewText /usr/share/doc/filerunner/COPYING }
  $wf.help_but.m add command \
      -label [_ "History" ] -command   { ViewText /usr/share/doc/filerunner/HISTORY }
  $wf.help_but.m add command \
      -label [_ "Installation" ] -command   { ViewText /usr/share/doc/filerunner/README }
  $wf.help_but.m add command \
      -label [_ "FAQ" ] -command   { ViewText /usr/share/doc/filerunner/FAQ }
  $wf.help_but.m add command \
      -label [_ "Tips" ] -command   { ViewText /usr/share/doc/filerunner/Tips.txt }
  $wf.help_but.m add command \
      -label [_ "Known Bugs" ] -command   \
      { ViewText /usr/share/doc/filerunner/KnownBugs.txt }
  $wf.help_but.m add command \
      -label [_ "To Do" ] -command   \
      { ViewText /usr/share/doc/filerunner/To_Do.txt }
}
  # Lay out the menus on the top of the window
  pack $wf.file_but \
      $wf.configuration_but \
      $wf.utils_but \
      $wf.fasync_cmds -side left
  pack $wf.fasync_cmds.clone \
      $wf.fasync_cmds.abort -side left
  pack $wf.help_but -side right
  label $wf.clock -text "[Time]      "
  balloonhelp_for $wf.clock \
      {[_b "Current date & time of day." ]}
  pack $wf.clock -side right
  # Put in who we are and what machine...
  # really need a good way to tell if we are running with root
  # privileges.  For now...
  if { [expr {$glob(os) != "WIN32"} && {[exec whoami] == "root"}]} {
    label $wf.user -text "root@$env(HOST)  "
  } elseif {$glob(os) != "WIN32"} {
    label $wf.user -text "$env(USER)@$env(HOST)  "
  } else {
    label $wf.user -text "$env(USERNAME)@$env(HOST)  "
  }
  balloonhelp_for $wf.user \
      {[_b "Current user & machine names." ]}
  pack $wf.user -side right
  # Reserve our status line just below the menu bar
  label $glob(win,top).status -relief groove -bd 2 -text {}
  balloonhelp_for $glob(win,top).status \
      {[_b "Status message line.\
          \nFull info on selected file appears here.\
          \nAlso other progress messages show up here." ]}

  pack $wf $glob(win,top).status -side top -fill x

  # Build the left and right panels
  BuildFileListPanel left
  BuildFileListPanel right
  
  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
  set wc [canvas .fupper.can -background orange]
  set glob(win,can) $wc
  set wm [frame $glob(win,middle) ] ; # -background gold

  set glob(cmds,list)  { 
    { { ->      CmdToright {[_b "Dup left dir list in right." ]} } 
      { <-      CmdToleft {[_b "Dup right dir list in left." ]} } }
    { { ->      ColToright {[_b "Dup left column order and size on right."]}}
      { =       ToggleCollock {[_b "Lock/unlock left/right column order & \
                                    sizes\n= -> Locked\n# -> Unlocked \
                                    (enabled if the same)\n"]}}
      { <-      ColToleft {[_b "Dup right column order and size on left."]}}}
    { {[_ "Copy" ]}      CmdCopy c 0 \
	  {[_b "Copy selected file(s) to other dir.\nif\
          the selected file is a dir, recursively\ncopies\
          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." ]} }
    { {[_ "Rename" ]}    CmdRename r 0 \
	  {[_b "Rename selected file(s).\nCan cause move." ]} }
    { {[_ "MkDir" ]}     CmdMakeDir "" 0 \
	  {[_b "Create new dir from modified dir line.\nIf\
           no modified dir line, prompts with\nleft dir as starter." ]} } 
    { {[_ "S-Link" ]}    CmdSoftLink s 0 {[_b "Create a symbolic link\
           to\nselected file(s) in other dir." ]} }
    { {[_ "S-LnAs" ]}    CmdSoftLinkAs "" 0 {[_b "Create a symbolic link to\
           selected\nfile(s) in other dir.\
           prompting for a\nnew 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,\nfor\
           files, execute the %s rule selected\nprogram\
           with the selected file." "View"]} }
    { {[_ "ViewAsTx" ]}      CmdViewAsText "" 0 \
	  {[_b "Sends selected files directly to a View\n\
           window regardless of file type or extension."]} }
    { {[_ "Open" ]}      CmdOpen o 0 \
	  {[_b "For dirs, go to the selected dir,\nfor\
           files, execute the %s rule selected\nprogram\
           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\nthe\
           user definded editor." ]} } 
    { {[_ "Q-Edit" ]}    CmdQEdit q 0 \
           {[_b "Pass the selected file(s) to\nthe\
            internal (tcl) editor." ]} } 
    { {[_ "Arc" ]}       CmdArc a 0 \
	  {[_b "Pass the selected file to the\n rule\
           defined archive program." ]} } 
    { {[_ "UnArc" ]}     CmdUnArc u 0 \
	  {[_b "Pass the selected file to the\n rule\
           defined unarchive program." ]} } 
    { {[_ "UnPack" ]}    CmdUnPack p 2 \
	  {[_b "Pass the selected file to the rule\ndefined\
           unpack/uncompress program." ]} } 
    { {[_ "ForEach" ]}   CmdForEach "" 0 \
	  {[_b "Run a selected (prompted for)\nprogram on\
          selected file(s)." ]} } 
    { {[_ "Print" ]}     CmdPrint "" 0 \
	{[_b "Pass the selected files to the\nuser\
         defined print program." ]} } 
    { {[_ "Diff" ]}      CmdDiff f 2 \
         {[_b "Pass the last two selected files or\ndirs\
         (may both be in the same dir) to\nthe user\
         defined diff program." ]} } 
    { {[_ "Select" ]}    CmdSelect "" 0 \
         {[_b "After you enter a pattern\n in\
          one of the dir lines,\n selects\
          all matching files." ]} } 
    {  {[_ "HardLnk" ]}   CmdHardlnk h 0 \
          {[_b "Creates hard links in the opposit dir\n of\
           selected files.  If the selection is a\n dir\
           recursively desends the dir creating hard\n links\
           for each file. Uses a user selected program." ]} }
  }

# moved    { C-Select  CmdCSelect } 
# moved    { RunCmd    CmdRunCmd } 

  set glob(cmds,cur) 0
 
  set wscr [frame .fupper.scroll -borderwidth 0 -relief raised]
  button $wscr.up -bitmap \
      @$glob(lib_fr)/bitmaps/pgup.bit -command "whatDoesTheFoxSay $wc -1"
  balloonhelp_for  $wscr.up \
      {[_b "Scroll the center buttons\
          \n(mouse wheel anywhere on buttons does this too)." ]}
  button $wscr.down -bitmap \
      @$glob(lib_fr)/bitmaps/pgdown.bit -command "whatDoesTheFoxSay $wc 1"
  balloonhelp_for  $wscr.down \
	   {[_b "Scroll the center buttons\
          \n(mouse wheel anywhere on buttons does this too)." ]}
  $wscr config -height [winfo reqheight $wscr.up]
  grid  $wscr.up $wscr.down -row 1 -sticky nsew
  grid columnconfigure $wscr all -weight 1

  # the <- -> middle buttons...
  set c [lindex $glob(cmds,list) 0]
  set n 1
  frame $wm.$n -bd 0 ; # -background red
  button $wm.$n.2 -bitmap \
      @$glob(lib_fr)/bitmaps/right.bit -command \
      "DoProtCmd [lindex $c 0 1]"
  balloonhelp_for $wm.$n.2 [lindex $c 0 2]
  button $wm.$n.1 -bitmap \
      @$glob(lib_fr)/bitmaps/left.bit -command \
      "DoProtCmd [lindex $c 1 1]"
  balloonhelp_for $wm.$n.1 [lindex  $c 1 2]
  # pack $wm.$n.2 -side left -expand 1 -fill x
  # pack $wm.$n.1 -side right -expand 1 -fill x
  # pack $wm.$n -side top -fill x
  grid $wm.$n -row $n  -sticky ew
  grid $wm.$n.1 -row 0 -column 1 -sticky news
  grid $wm.$n.2 -row 0 -column 2 -sticky news
  grid columnconfigure $wm all -weight 1
  grid columnconfigure $wm.$n all -weight 1 -uniform 1

  incr n
  set c [lindex $glob(cmds,list) 1]
  frame $wm.$n -bd 0
  button $wm.$n.1 -text [lindex $c 0 0] -command \
      "DoProtCmd [lindex $c 0 1]" -bitmap @$glob(lib_fr)/bitmaps/small-right.bit
  balloonhelp_for $wm.$n.1 [lindex $c 0 2]
  button $wm.$n.2 -text [lindex $c 1 0] -command \
      "DoProtCmd [lindex $c 1 1]" -bitmap @$glob(lib_fr)/bitmaps/small-equ.bit
  balloonhelp_for $wm.$n.2 [lindex $c 1 2]
  button $wm.$n.3 -text [lindex $c 2 0] -command \
      "DoProtCmd [lindex $c 2 1]"  -bitmap @$glob(lib_fr)/bitmaps/small-left.bit
  balloonhelp_for $wm.$n.3 [lindex $c 2 2]
  grid $wm.$n -row $n -sticky ew
  grid $wm.$n.3 -row 0 -column 1 -sticky ew
  grid $wm.$n.2 -row 0 -column 2 -sticky ew
  grid $wm.$n.1 -row 0 -column 3 -sticky ew
  grid columnconfigure $wm.$n all -weight 1 -uniform 1

  # pack $wm.$n.3 -side left  -fill x -expand 1
  # pack $wm.$n.2 -side left -expand 1 -fill x
  # pack $wm.$n.1 -side right -fill x -expand 1
  # pack $wm.$n -side top -fill x
  # put the middle button fram in a canvas widgit so we can scroll it.
  $wc create window 0 0 -window $wm -anchor nw
  foreach win "$wscr.up $wscr.down $wm.1.1 $wm.1.2 $wm.2.1 $wm.2.2 $wm.2.3" {
    bind $win <MouseWheel> "whatDoesTheFoxSay $wc -%D;break"
    bind $win $config(mwheel,neg) "whatDoesTheFoxSay $wc -1 ;break"
    bind $win $config(mwheel,pos) "whatDoesTheFoxSay $wc  1 ;break"
  }

  incr n
  set glob(preButCount) $n
  # set glob(preButEnd) $y
  # set glob(preButWidth) $width
  # Build command windows
  BuildCmdWindow left
  BuildCmdWindow right

  pack .fupper -side top -fill both -expand 1
  pack .flower -side bottom -expand 1 -fill both
  # 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 propagate .fupper 0
  pack forget $glob(win,bottom)
  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}"
}


proc postConfigShow {} {
  global glob config win fast_checkboxes 
# We do this after we read the config file, for what ever reason
# So it needs to be able to be re-executed each time.

#  proc what {in } { puts "$in"}
  wm geometry . $config(geometry,main)
  set n 0
  set w  $glob(win,top).menu_frame.fasync_cmds
  foreach k $config(fast_checkboxes) {
    if { [lindex $k 2] != "d" } {
      if {[set kn [lsearch -index 0 -exact \
		       $fast_checkboxes [lindex $k 0]]] != -1 } {
	set kk [lindex $fast_checkboxes $kn]
#	puts "$w.$n checkbox"
	destroy $w.$n
	checkbutton $w.$n -takefocus 0 -variable [lindex $kk 2] \
 	    -text "[lindex $k 1]" \
            -command "[lindex $kk 1]"
        #   -selectcolor #fffffe 
	balloonhelp_for $w.$n  [lindex $kk 3]
	pack $w.$n -side left
	incr n
      }
    }
  }
  # 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]
    }
  }
  # Purge old user commands from the cmds,list
  while {[lindex $glob(cmds,list) end 1 0] == "DoUsrCmd"} {
    set glob(cmds,list) [lreplace $glob(cmds,list) end end]
  }
  # Now add the new set    
  set foo {}
  set savcon 0
  # the following code makes sure that the config button list is complete
  # missing entries are supplied as disabled.
  foreach cmd [lrange $glob(cmds,list) 2 end] {
    set text [eval concat [lindex $cmd 0]]
#    puts "[lindex $cmd 0] $cmd "
    if {[lsearch -index 0 -exact $config(middle_button_list) $text] == -1 } {
      lappend config(middle_button_list) $text 
      set savcon 1
    }
  }
  # This cleans any entries in the config button list that we don't know
  # about.
  foreach cmd $config(middle_button_list) {
    if {[lsearch -exact -index 0 $config(usercommands) [lindex $cmd 0]] != -1} {
      lappend newcmds $cmd
      continue
    }
    foreach ent $glob(cmds,list) {
      set text [eval concat [lindex $ent 0]]
      if {[lindex $cmd 0] == $text } {
	lappend newcmds $cmd
      }
    }
  }
  if {$config(middle_button_list) != $newcmds} {
    set config(middle_button_list) $newcmds
    set savcon 1
  }
  foreach k $config(usercommands) {
    lappend foo [list [lindex $k 0] \
		     [list DoUsrCmd [lindex $k 1]] \
		     {} {} \
		     [lindex $k 2]]
    if {[lsearch -index 0 -exact $config(middle_button_list) \
	     [lindex $k 0]] == -1 } {
      lappend config(middle_button_list)  [lindex $k 0]
      set savcon 1
    }
  }
  if {$savcon == 1} {
    SaveConfig
  }
  set glob(cmds,list) [concat $glob(cmds,list) $foo]
  set n $glob(preButCount)
  set wc $glob(win,can)
  set wm $glob(win,middle)
  for {set nn $n} \
      {$nn <= [expr {2 * [llength $config(middle_button_list)]}]} \
      {incr nn} {
	destroy $wm.$nn
      }
  foreach b $config(middle_button_list) {
    if { [lindex $b 1] != "d"} {
      # Here we translate from the users button list to the internal
      # list of buttons.
 #     set re  "\[\[.\[.\] _\"]*[lindex $b 0]\[\[.\].\]\" ]*"
      set re  "\[^\[:alpha:]\]*[lindex $b 0]\[^\[:alpha:]\]*"
#      what $re
      # do we need -index 0 here?
      set cc [lsearch -regexp $glob(cmds,list) $re ]
      if { $cc != -1 } {
	# Found it.
	set c [lindex $glob(cmds,list) $cc]
#	puts "doing button [lindex $c 0]"
	set text [eval concat [lindex $c 0]]
	button $wm.$n -text $text -command \
	    "set glob(mbutton) 1; DoProtCmd \"[lindex $c 1]\""
#	balloonhelpd_for $wm.$n "Wait for it.."
	balloonhelp_for $wm.$n [lindex $c 4]
	if {[lindex $c 2] != "" && $config(keyb_support)} {
	  $wm.$n configure -underline [lindex $c 3]
	}
	bind $wm.$n <3> "set glob(mbutton) 2
                         set glob(async) 1
                         DoProtCmd \"[lindex $c 1]\""
	bind $wm.$n <2> "set glob(mbutton) 3
                         DoProtCmd \"[lindex $c 1]\""
	grid $wm.$n -row $n -sticky ew
	#pack $wm.$n -side top -fill x
	incr n
      }
    }
  }
  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.
  foreach c $glob(cmds,list) {
    set name [eval concat [lindex $c 0]]
    switch -regexp $name {
      ^[[:alnum:]].* {
	lappend glob(middlebuttoncmds) [list [eval concat [lindex $c 0]] \
					 [lindex $c 1] [lindex $c 4]]
      }
    }
  }
  update idletasks
  set rq [winfo reqheight $wm]
  $wc config -scrollregion [list 0 0 0 $rq] \
      -width [winfo reqwidth $wm]\
      -yscrollincrement [winfo reqheight $wm.$glob(preButCount)]

  setMidButColor
}

proc setMidButColor {} {
  global glob config
  foreach w [winfo child $glob(win,middle)] {
    if {[catch {$w config -text} out] != 0} {continue}
    set out [lindex $out 4]
    set indx [lsearch -exact -index 0 -all $config(middle_button_colors) $out]
    if {$indx == -1} {continue}
    foreach ind $indx {
      foreach color [lrange [lindex $config(middle_button_colors) $ind] 1 end] {
	if { [string index $color 0] == "-" } {
	  $w configure -activebackground [set color [string range $color 1 end]]
	} else {
	  $w configure -background $color -activebackground [LighterColor2 $color]
	}
      }
    }
  }
}

proc whatDoesTheFoxSay {w scr {scrinc 1}} {
  # 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)
  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
  if {$glob(panelsLocked)} {
    set glob(panelsLocked) 0
    $glob(win,middle).2.1 configure -state normal
    $glob(win,middle).2.3 configure -state normal
    $glob(win,middle).2.2 configure \
	-bitmap @$glob(lib_fr)/bitmaps/small-noeq.bit
  } else {
#    if {$config(ListBoxColumns,left) != $config(ListBoxColumns,right) } {}
    set glob(panelsLocked) 1
    $glob(win,middle).2.1 configure -state disabled
    $glob(win,middle).2.3 configure -state disabled
	$glob(win,middle).2.2 configure \
	-bitmap @$glob(lib_fr)/bitmaps/small-equ.bit \
	-state normal
  }
}

proc ColToleft {} {
  ColTo right left
}

proc ColToright {} {
  ColTo left right
}
proc ColTo { from to args} {
#  puts "ColTo $from $to $args"
  global glob config
  if {$config(ListBoxColumns,left) != $config(ListBoxColumns,right)} {
    set config(ListBoxColumns,$to) $config(ListBoxColumns,$from)
#   $glob(listbox,$to)
    $glob(win,middle).2.2 configure -state normal
    buildListBox $to
    ReConfigColors foo
    ReConfigFont
  }
}
proc TraceColTo { from to args} {
  global glob config
  if {$glob(panelsLocked)} {
    ColTo $from $to
  } else {
    $glob(win,middle).2.2 configure -state \
	[expr {$config(ListBoxColumns,left) != $config(ListBoxColumns,right) ? \
		   "disable" : "normal"}]
 }

}

proc EditColor { color } {
  global config glob
  if {[info exist glob(colorArray)]} {
    foreach ent $glob(colorArray) {
      unset -nocomplain glob($ent)
    }
    unset -nocomplain glob(colorArray)
  }
  set c $config(gui,$color)
  if {$c == ""} {set c [set config(gui,$color) grey85]}
  ColorEditor $color "global config;\
      set config(gui,$color) %%;ReConfigColors" $c $config(gray)
}


proc ReConfigFont {} {
  global glob config
  if {$config(gui,GuiFont) != "" \
	  && $config(gui,GuiFont) != $glob(gui,GuiFont)} {
    catch {tk_setFont $config(gui,GuiFont)} out
    set glob(gui,GuiFont) $config(gui,GuiFont)
  }
  #  if {$config(gui,ListBoxFont) != $glob(gui,ListBoxFont)} {}
  foreach k $glob(gui,color_xx,winlist) {
    catch {$k configure -font $config(gui,ListBoxFont)}
  }
  foreach inst {left right} {
    setListBoxFont $glob(listbox,$inst) {$config(gui,ListBoxFont)}
  }
  foreach class {Entry Text Listbox} {
    option add *$class.Font $config(gui,ListBoxFont)
  }
  set glob(gui,ListBoxFont) $config(gui,ListBoxFont)
  # balloon window may not have been set up yet...
#  catch {set ::balloon_help::font $config(gui,BalloonHelpFont)}
  balloon_help_config font $config(gui,BalloonHelpFont)
  #{  }
}

# 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 
}

proc ReConfigColors {args} {
  global glob config
  set do {}
  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_balloonHelp_fg color_balloonHelp_bg\
		 color_handle} {
    if {$config(gui,$c) != $glob(gui,$c) || $args != {} || $c in $do} {
      switch $c {
	color_scheme {
	  set Cl {Button Checkbutton Menubutton Radiobutton Canvas
		      Scrollbar Label Menu Frame Scale Dialog}
	  makePalette $config(gui,$c) cols new
	  foreach cl $cols {
	    setOptionF $Cl *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 *Tear* selectColor $new(foreground)
	  # set the special middle button colors, if any
	  setMidButColor
	  # let the other color sections take the Label and handles..
	  # this line requires that 'color_scheme' is before these int
	  # the foreach loop.
	  lappend do color_fg color_bg color_handle
	}
	color_bg {
	  frputs "color_bg  " config(gui,$c)
	  setOption background $config(gui,$c)
	  doWidget .fupper Label [list .fupper.ftop* .fupper.*.top.t* ] \
	      "\[set wd] config -background $config(gui,$c)"
	}

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

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

	color_select_bg	{
	  setOption {selectBackground activeBackground inactiveSelectBackground}\
	      $config(gui,$c)
	  foreach inst {left right} {
	    $glob(win,bottom).fcmdwin$inst.text tag config complete \
		-background $config(gui,$c)
	  }
	}
	color_cursor {setOption insertBackground $config(gui,$c)}
	color_cmd {
	  foreach inst {left right} {
	   $glob(win,bottom).fcmdwin$inst.text tag config command  \
	       -background $config(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"}] $config(gui,$c)
	}
	color_balloonHelp_fg {balloon_help_config fg $config(gui,$c)}
	color_balloonHelp_bg {balloon_help_config bg $config(gui,$c)}
	color_handle {
	  $glob(listbox,left)  config -bg $config(gui,color_handle)
	  $glob(listbox,right) config -bg $config(gui,color_handle)
	}
      }
    }
    set glob(gui,$c) $config(gui,$c)
  }
  # we use special help for the balloon help and the secondary selections
  # foreach bc { bg fg } {
  #   if {$config(gui,color_balloonHelp_$bc) != $glob(gui,color_balloonHelp_$bc) ||\
  # 	    ! [info exists ::balloon_help::$bc] || \
  # 	    $config(gui,color_balloonHelp_$bc) != [set ::balloon_help::$bc]} {
  #     balloon_help_config $bc $config(gui,color_balloonHelp_$bc)
  #     set $glob(gui,color_balloonHelp_$bc) $config(gui,color_balloonHelp_$bc)
  #   }
  #   if {$config(gui,color_highlight_$bc) != $glob(gui,color_highlight_$bc)} {
  #     if {$glob(select_pry_lr) != {}} {
  #     	twidleHighlight $glob(select_pry_lr) on $glob(select_pry_s)
  #     	set glob(gui,color_highlight_$bc) $config(gui,color_highlight_$bc)
  #     }
  #     setOption [expr {$bc == "fg" ? "highlightColor" : \
  # 			   "highlightBackground"}] \
  # 	  $config(gui,color_highlight_$bc)
  #   }
  # }
  # the handles actually are areas where we don't cover the listboxes
  # with other windows
  # set glob(gui,color_handle) $config(gui,color_handle)
  # $glob(listbox,left)  config -bg $config(gui,color_handle)
  # $glob(listbox,right) config -bg $config(gui,color_handle)

}

proc setOption {ops val} {
  setOptionF {Entry Listbox Text} *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 in
# faster.

proc doWidget {w class except args} {
  global glob
  if {![info exists glob($w,$class)]} {
    set glob($w,$class) [BuildSelectWidgetList $w $class $except]
    lappend glob(colorArray) $w,$class
    frputs "doWidget Build list for $w,$class "
  } else {
    frputs "doWidget HAVE list for $w,$class "
  }
  foreach wd $glob($w,$class) {
    foreach arg $args {
      set r [catch "eval $arg" out]
    }
  }
}


proc evalOverArgs {wd args} {
  foreach arg $args {
    set r [catch "eval $arg" out]
  }
}
#    frputs "evalOverArgs  " wd arg args out

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 srtn [BuildSelectWidgetList $ch $class $except]
    if {$srtn != {} } {
      lappend rtn {*}$srtn
    }
  }
  return $rtn
}

proc FindDialog { result inst } {
  global glob config

  incr glob(toplevelidx)  
  set w .toplevel_$glob(toplevelidx)
  toplevel $w -class Dialog
  wm title $w [_ "Files Found"]
  wm iconname $w [_ "Files Found"]
  wm resizable $w true true
  wm transient $w [winfo toplevel [winfo parent $w]]

  frame $w.top
  frame $w.bot
  scrollbar $w.top.scrollvert -command "$w.top.list yview" -orient vertical 
  scrollbar $w.top.scrollhoriz -command "$w.top.list xview" -orient horizontal 
  listbox $w.top.list \
      -yscrollcommand "$w.top.scrollvert set" \
      -xscrollcommand "$w.top.scrollhoriz set" \
      -width 70 \
      -height 30 \
      -font $config(gui,ListBoxFont) 
      # -background $config(gui,color_bg) \
      # -foreground $config(gui,color_fg) \
      # -selectbackground $config(gui,color_select_bg) \
      # -selectforeground $config(gui,color_select_fg) 

  label $w.bot.text -text [_ "Click on a file name to show it in the list panel."]
  button $w.bot.ok -text [_ "OK"] -command "destroy $w"

  $w.top.list delete 0 end
  eval $w.top.list insert end $result

  pack $w.top -side top -expand 1 -fill both
  pack $w.top.scrollvert -side right -fill y
  pack $w.top.scrollhoriz -side bottom -fill x
  pack $w.top.list -side top -expand 1 -fill both
  pack $w.bot -side bottom -expand 1 -fill x
  pack $w.bot.text -side top -pady 4
  pack $w.bot.ok -side top

  wm withdraw $w
  update idletasks
  set pw [winfo parent $w]
  set x [expr [winfo width $pw]/2 - [winfo reqwidth $w]/2 \
      + [winfo x $pw]]
  set y [expr [winfo height $pw]/2 - [winfo reqheight $w]/2 \
      + [winfo y $pw]]
  wm geom $w +$x+$y
  wm deiconify $w

  bind $w.top.list <1> "
    GotoFind $glob($inst,pwd)/\[lindex \{$result\} \[$w.top.list nearest %y\]\]\
       $inst;break"
  bind $w.top.list <B1-Motion> "break"
}

proc GotoFind { file inst } {
  global glob
  NewPwd $inst [file dirname $file]
  UpdateWindow $inst
  set j 0
  set name [file tail $file]
  if {$name == {}} {return}
  foreach i $glob($inst,filelist) {
    if {[lindex $i 1] == $name} {
      $glob(listbox,$inst).file selection clear 0 end
      $glob(listbox,$inst).file selection set $j
      $glob(listbox,$inst).file see $j
      propagateSelection $glob(listbox,$inst).file
      return
    }
    incr j
  }
  PopError [_ "File %s/%s can not be found" $file]
}
#
#             '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
  set target [file normalize [info nameofex]]
  set script [file join $glob(start_path) $glob(program)]
  if {([file extension $target] == ".exe" && \
	  [string match -nocase *fr* [file tail $target]]) || \
	$target ==$script } {
    set script ""
  }
  cd  $glob(start_path);
  set cmd [list exec $target \
	       [FixFileName $script 2 "" n] \
	       [FixFileName $glob(left,pwd) 2 "" n] \
	       [FixFileName $glob(right,pwd) 2 "" n] &]
  catch $cmd 

#   exec $target  \
	     [ReSpaceString "" [FixFileName $script 2 ] noq]\
	     [ReSpaceString "" [FixFileName $glob(left,pwd) 2] noq] \
	     [ReSpaceString "" [FixFileName $glob(right,pwd) 2] noq] &
#  if {$r != 0} {PopError $out}
}
	    
#

proc ToggleCmdWin { inst } {
  global glob config
  if {$glob($inst,shell,packed)} {
    pack forget $glob(win,bottom).fcmdwin$inst
    if {!$glob([Opposite $inst],shell,packed)} {
      pack forget $glob(win,bottom)
#      grid remove  $glob(win,bottom)
    }
    set glob($inst,shell,packed) 0
    set glob($inst,shell,history,flipping) 0
  } else {
    if {!$glob([Opposite $inst],shell,packed)} {
      pack $glob(win,bottom) -side bottom -fill x
#      grid  configure $glob(win,bottom)  -column 0 -columnspan 3 -row 2 -sticky ew
    }
    $glob(win,bottom).fcmdwin$inst.text configure \
	-height $config(shell,height,$inst)
    set glob($inst,shell,maxed) 0
    pack $glob(win,bottom).fcmdwin$inst -side bottom -fill x
    set glob($inst,shell,packed) 1
  }
}

proc MaxWin { w 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
    set glob($inst,shell,maxed) 1
  }
}

proc BuildCmdWindow { inst } {
  global glob config

  frame $glob(win,bottom).fcmdwin$inst
  set w $glob(win,bottom).fcmdwin$inst

  text $w.text \
      -relief sunken \
      -bd 2 \
      -yscrollcommand "$w.fr.scroll set"\
      -font $config(gui,ListBoxFont) \
      -height $config(shell,height,$inst) 
  lappend glob(gui,color_xx,winlist) $w.text
  frame $w.fr -bd 0
  scrollbar $w.fr.scroll -command "$w.text yview" 
  frame $w.bot -bd 0
  entry $w.bot.entry \
      -relief ridge \
      -font $config(gui,ListBoxFont) \
      -highlightthickness 1 
  lappend glob(gui,color_xx,winlist) $w.bot.entry
  #$w.text tag configure command -background $config(gui,color_cmd)
  lappend glob(gui,color_cmd,winlist) $w.text
  # $w.text tag configure complete \
  #     -background $config(gui,color_select_bg)\
  #     -foreground $config(gui,color_select_fg)
  label $w.bot.label -textvariable glob($inst,pwd) \
      -font $config(gui,ListBoxFont) \
      -relief ridge \
      -padx 5
  button $w.bot.max \
      -bitmap @$glob(lib_fr)/bitmaps/max.bit \
      -command "MaxWin $w $inst" \
      -bd 1
  button $w.bot.smaller \
      -bitmap @$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 \
      -bitmap @$glob(lib_fr)/bitmaps/larger.bit \
      -command "incr config(shell,height,$inst) 2;\
               $w.text configure -height \$config(shell,height,$inst)" \
      -bd 1
  label  $w.bot.running -text [_ "R"]
  pack $w.fr.scroll -side bottom -fill y -expand 1
  pack $w.fr -side $inst -fill y
  pack $w.bot.label -side left 
  pack $w.bot.max -side right -fill y
  pack $w.bot.larger -side right -fill y
  pack $w.bot.smaller -side right -fill y
  pack $w.bot.running -side right -fill y
  pack $w.bot.entry -side bottom -fill x
  pack $w.bot -side bottom -fill x
  pack $w.text -expand 1 -fill both
  textSearch $w.text [_ "Cmd %s" $inst] "+buildViewConfig" {} \
      [list  {Save As...} "SaveToFile $w.text {} 1 "]
  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 <Enter> "focus $w.bot.entry"
  bind $w.bot.entry <Leave> "focus ."
  bind $w.bot.entry <3> "CompleteWithBrowse $w.bot.entry;break"

  bind $w.text <3> "tk_popup $w.text.p %X %Y;break"
  bind $w.text <Enter> "focus $w.bot.entry"
  bind $w.text <Leave> "focus ."
  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"
  balloonhelp_for $w.bot.entry \
      {[_b "Command entry window. Bindings:
<Return> execute the entered command.
<Tab>  \tAttempt command completion second
       \t<Tab> or <Cntl d> lists possible 
       \tcompletions in above window.
<Cntl c>\tIf empty entry line abort the
        \tlast command else clear the entry line.
<Up>   \tMove back in shell history.
<Down> \tMove forward in shell history.
<Cntl p>\tSearch back in command stack for
        \tcommand using entry as a pattern." ]}
}

# 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 need 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)]
      catch {chan close $fi}
      CompleteShell_pipe $inst $w $fi
    } else {
      Log [_ "Command does not exist"]
    }
  }
}

proc buildViewConfig {} {
  global  config
  set return [list -flashcolor $config(gui,color_flash)]
  if {0} {-font $config(gui,GuiFont)}
  return $return
}
proc buildDialogConfig {} {
  global  config
  return [list -font $config(gui,ListBoxFont) \
	      -width 70 ]
}

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] \
                 `[lrange [lindex $config(shell,aliases) $indx] 1 end]'\n"
	continue
      }
      set indx [lsearch -exact $glob(localCmds) $arg]
      if {$indx != -1} {
	ToShellBuffer $w [_ "%s is a filerunner builtin\n" $arg]
	continue
      }
      set cmd "type $arg"
      set r [catch {open "|$config(cmd,sh)  \{$cmd 2>&1\}" r} fid]
      if {$r} {
	ToShellBuffer $w [_ "Exec error: %s\n" $fid]
      } else {
	fconfigure $fid -buffering none
	fconfigure $fid -blocking 0
	fconfigure $fid -translation auto
	lappend glob($inst,fid) $fid
	# schedule the completer...
	incr glob($inst,shellcount)
	chan event $fid readable "CompleteShell_pipe $inst $w $fid"
	set glob($inst,runlabel,bg) [$w.bot.running cget -bg]
	$w.bot.running configure -bg red
	vwait glob($inst,shellcount)
      }
    }
  }
}


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
  lappend glob($inst,shell,history) $cmd
#  if {[IsFTP $glob($inst,pwd)] && ![string match "%*" $verb ]} {
#    PopError [_ "Sorry, can't execute commands in ftp directories"]
#    return
#  }
  if { [IsFTP $glob($inst,pwd)] } {
    set r [catch {FTP_CD $ftpI $directory} 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 wnat to convert other '\' so that they stay around...
  # Mostly for Windows
  set qt [string range {""} 1 1]
  #
  set tt {}
  set cmd [regsub -all {\\} [regsub -all {\\ } $cmd $config(space)] {\\}]
  set ncmd {}
  while {[regexp {(^[^ ]+)( *|$)(.*)} $cmd m first mid second]} {

    if { [regsub -all "$config(space)" $first { } first] && \
	     [string range $first 0 0] != $qt } {
      set ncmd "$ncmd ${qt}${first}${qt}"
    } else {
      set ncmd "$ncmd $first"
    }
    set cmd $second
  }
  set cmd [string range $ncmd 1 end]
  set r [catch {set verb [lindex $cmd 0]} out]
  if {$r } {
    ToShellBuffer $w "\n$glob($inst,pwd) > $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 [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,pwd) > $cmd\n" 1
  update
  set len [llength $glob($inst,shell,history)]
  if {$len > 250} {
    set glob($inst,shell,history) [lrange [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 {[IsFTP $glob($inst,pwd)]} {	
	ToShellBuffer $w [_ "cd not supported as a\
                             shell command in ftp 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 {[IsFTP $glob($inst,pwd)]} {	
	ToShellBuffer $w [_ "view not supported as \
                             shell command in ftp directories"]
      } else {
	ViewAny [lrange $cmd 1 end]
      }
    }
    history {
      Log [_ "history"]
      ToShellBuffer $w "$glob($inst,shell,history)"
    }
    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 FTP
      if {[string match *& $cmd]} {
	set prefix [_ "Background shell: "]
	catch {puts "$cmd"}
	set cmd [regsub {\\} $cmd {\\\\}]
	catch {eval exec $cmd} out
	ToShellBuffer $w $out
      } elseif {[IsFTP $glob($inst,pwd)] } {
	set prefix [_ "FTP command: "]
	ToShellBuffer $w [FTP_command $ftpI $cmd]
      } else {
	set prefix [_ "Shell: "]
	if {$glob(os) == "Unix"} {
	  set cmd [regsub -all {\\} $cmd {\\\\}]
	} else {
	  set cmd [regsub -all {\\} $cmd {\\}]
	}
	# {open "|$config(cmd,sh)  \{$cmd 2>&1\}" r} fid]
	set r [catch {open "|[list {*}$config(cmd,sh) $cmd 2>@1]" r} fid]
	frputs "[list {*}$config(cmd,sh)  $cmd 2>@1] "
	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
	  }
	  fconfigure $fid -buffering none
	  fconfigure $fid -blocking 0
	  fconfigure $fid -translation auto
	  lappend glob($inst,fid) $fid
	  # schedule the completer...
	  chan event $fid readable "CompleteShell_pipe $inst $w $fid"
	}
      }
    }
  }
  Log $prefix$cmd
}


proc CompleteShell_pipe { inst w fid} {
  global glob 
  Log [_ "%s called" CompleteShell_pipe]
  set out ""
  set r [catch {set out [read $fid]} ]
    if {$out != ""} {
    ToShellBuffer $w "$out"
  }
  if {$r || [eof $fid]} {
    # do we need this???
    # if {[$w.text get "end - 1 chars"] == "\n"} {
    #  $w.text delete "end - 1 chars"
    # }
    # Maybe this is better...
    if {[$w.text get "end - 1 chars"] != "\n"} {
      ToShell_buffer $w "\n"
    }
    catch {close $fid}
    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)
    }
    Log [_ "aborting %s %s" $r $fid]
    if { $r } {
      Log [_ " aborted"]
    } else {
      Log [_ " - done"]
    }
  }
}



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"
  }
  $w.text see "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
  }
}

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
  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)]
}


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
}
# We want the doProt family to be re-entrant so we don't lose the cursor/
# update status...
#
set DoProtLevel 0
set MaxDoProtLevel 0

proc DoProtCmd_ {cmd {nograb 0}} {
  global glob DoProtLevel
  if {! $nograb} {
    focus $glob(win,top).status
    frgrab $glob(win,top).menu_frame.fasync_cmds
  }
  set glob(doprot,$DoProtLevel) \
      [list [. cget -cursor] $glob(enableautoupdate)]
  incr DoProtLevel
  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)
  . config -cursor circle
  #wm iconname . "FileRunner v$glob(version) - busy"
  update idletasks
  if {$glob(enableautoupdate) != 0} {
    # we do this to avoid extra trace calls (see list updater)
    set glob(enableautoupdate) 0
  }
  set glob(abortcmd) 0
  frputs "DoProtCmd:  " cmd
  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
  lassign $glob(doprot,$DoProtLevel) curser update
  if {$update != $glob(enableautoupdate) } {
    set glob(enableautoupdate) $update
  }
  set glob(async) 0
  . config -cursor $curser
#  puts "set $glob(oldcur)"
  catch {grab release [grab current]}
  #catch {focus $glob(focus_before_doprotcmd)}
  unset -nocomplain glob(whichdir)
  # Not sure if the following line is needed.  Be not having it we can
  # do much more with Left & Right Up & Down keys even in normal mode.
  if {$config(focusFollowsMouse) != 1} {
    focus $glob(win,top).status 
  }
  set glob(mbutton) 0
}
#
# 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
  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
  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
  set config(geometry,main) [wm geometry .]
  LogStatusOnly \
      [_ "%s set. Do\
       \"Configuration->Save configuration\" if\
       you want to store it to the .fr file" sconfig(geometry,main)]
}


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

 Copyright (C) 2010-2013 \"Tom Turkey\"
 Copyright (C) 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 for further details.
" $glob(version)]] 0 1 [_ "OK"] \
      [list -font -Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-* \
	   tag {config tag -justify center} \
	  -borderwidth 10\
	  -flashon 0]
}

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

proc ButtonAdd {w args} {
  global glob
  foreach arg $args {
    foreach {lab addToCmdsList com } $arg {
      $w add command -label $lab -command $com
      if {$addToCmdsList == "+" } {
	set com [regsub {(.*)( left)|( right)(.*)} $com {\1\4}]
	if {[lsearch -exact $glob(buttoncmds) [list $lab $com]] == -1} {
	  lappend glob(buttoncmds) [list $lab [lindex $com 1]]
	}
      }
    }
  }
}

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
  menubutton $wf.dir_but -takefocus 0 -menu \
      $wf.dir_but.m -direction right\
      -bitmap @$glob(lib_fr)/bitmaps/tree.bit
  balloonhelp_for $wf.dir_but \
      {[_b "Directory tree scan." ]}

  menu $wf.dir_but.m -font $config(gui,GuiFont) \
      -tearoff false -postcommand  "eval CdMenuCreate \
      ${inst} \[Esc \$glob($inst,pwd) \] \
      $wf.dir_but.m 1"

  # Hotlist button
  menubutton $wf.hotlist_but -takefocus 0 -menu \
      $wf.hotlist_but.m -text [_ "Hotlist"]

  menu $wf.hotlist_but.m  -font $config(gui,GuiFont)\
      -tearoff false -postcommand "CreateHotListMenu $inst"
  # History button  
  menubutton $wf.history_but -menu \
      $wf.history_but.m -text [_ "History"]

  menu $wf.history_but.m  -font $config(gui,GuiFont)\
      -tearoff false -postcommand "CreateHistoryMenu $inst"

  # 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 \
      -font $config(gui,GuiFont)
  ButtonAdd $wf.etc_but.m \
      [list {Find File...}         + "DoProtCmd \"CmdFind $inst\"" \
	   {Create Empty File...}  + "DoProtCmd \"CmdCreateEmptyFile $inst\"" \
	   {Recurse Command...}    + "DoProtCmd \"CmdRecurseCommand $inst\"" \
	   {Add To FTP Batch List} - "AddToBatchList $inst" \
	   {View FTP Batch List}   - "ViewBatchList" \
	   {Clear FTP Batch List}  - "set glob(batchlist) {}" \
	   {FTP Batch Receive}     - "DoProtCmd \"BatchReceiveFTP $inst\"" \
	   {HTTP Download}         + "DoProtCmd \"CmdGetHttp $inst\""
       ]

  # Create buttons
  #  the ^ button
  button $wf.button_parentdir -takefocus 0 \
      -borderwidth 1 -bitmap @$glob(lib_fr)/bitmaps/up.bit 
#      -command "UpDirTree $inst %x %y"
  bind $wf.button_parentdir <1> \
      "UpDirTree $inst %X %Y"

  # the <- button
  button $wft.button_back -takefocus 0 -borderwidth 1 \
      -bitmap  @$glob(lib_fr)/bitmaps/left.bit \
      -command  "DoProtCmd \"  Back ${inst}\"" -width 22
  balloonhelp_for $wft.button_back \
      {[_b "Go back thru the push down stack of dir visits." ]}
 
  # Start a terminal program button
  button $wft.button_xterm -takefocus 0 \
      -borderwidth 1 -bitmap @$glob(lib_fr)/bitmaps/xterm.bit \
      -command "Try \" StartTerm \\\$glob(${inst},pwd) $inst \" \"\" 1"
  balloonhelp_for $wft.button_xterm \
      {[_b "Launch the user specified\n terminal\
          program in a new window." ]}

  # The command at the bottom button
  button $wft.button_frterm -takefocus 0 \
      -borderwidth 1 -bitmap @$glob(lib_fr)/bitmaps/frterm.bit \
      -command "ToggleCmdWin $inst"
  balloonhelp_for $wft.button_frterm \
      {[_b "Open/Close a command sub\n window\
         at the bottom of this one." ]}

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

  # The dir line window
  entry $glob(win,$inst).entry_dir -takefocus 0 \
      -relief {ridge} \
      -font $config(gui,ListBoxFont) \
      -selectbackground $config(gui,color_select_bg) \
      -selectforeground $config(gui,color_select_fg) \
      -background $config(gui,color_bg) \
      -foreground $config(gui,color_fg) \
      -highlightthickness 1 
  lappend glob(gui,color_xx,winlist) $glob(win,$inst).entry_dir
  balloonhelp_for $glob(win,$inst).entry_dir \
      {[_b "Dir line.\nFollows dir changes.\nEnter\
          a new dir here if desired.\nAlso\
          used as input by MkDir and Select\n buttons.\
          Button 2 (paste) of a file name here\nwill\
          open the referenced dir and select\nthe\
          file after traceing links." ]}

#  selection handle $lbw.$swin  \
#      GetFileListBoxSTRING_Selection STRING

  label $wft.t.stat -text "" -justify center

#  button $glob(win,$inst).frame_listb.v.but \
#      -bitmap @$glob(lib_fr)/bitmaps/toggle.bit \
#      -command "ToggleSelect $inst" \
#      -width 1 -height 12 -bd 1
  pack $wf.dir_but \
    $wf.hotlist_but \
    $wf.history_but \
    $wf.etc_but -side left -fill both
  pack $wf.button_parentdir \
      -side left -expand 1 -fill both


  pack $wft -side top -fill x
  pack $wft.button_xterm -side right -fill both
  pack $wft.button_frterm -side right -fill both
  pack $wft.button_back -side left -fill both
  pack $wft.button_update -side left -fill both
  pack $wft.t -side left -fill both -expand 1
  pack propagate $wft.t 0
  pack $wft.t.stat -side left -fill both -expand 1
  pack $wf -side top -fill x
  pack $glob(win,$inst).entry_dir -side top -fill x
#  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
  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,*"]] {
    switch -glob $ref {
      DoMenu,* {}
      default { 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
  foreach {but val} [array get config "bind,*"] {
    foreach inst {left right} {
      set glob($but,$inst) [findCommand $val $inst]
    }
  }
}

proc buildMenu {name w inst val} {
  global glob config 
  menu $w.$name \
      -tearoffcommand "AnchorTearoff ." \
      -title $name \
      -tearoff true \
      -font $config(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 "RaiseMenu $w.$name"]
}

proc findCommand {name inst} {
  global glob
  foreach ent [concat $glob(buttoncmds) \
		   $glob(middlebuttoncmds) \
		   $glob(menus,$inst)] {
    lassign $ent nam cmd
    if {$nam == $name} {return $cmd}
  }
  #error "command $name not found"
  return $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
proc buildListBox {inst} {
  global glob config
  destroy $glob(win,$inst).frame_listb
  frame $glob(win,$inst).frame_listb -bd 0
                           # -background $config(gui,color_bg) \
                           # -foreground $config(gui,color_fg) \
                           # -activebackground $config(gui,color_select_bg) \
                           # -activeforeground $config(gui,color_select_fg) \

                           # -background $config(gui,color_bg) \
                           # -foreground $config(gui,color_fg) \
                           # -selectbackground $config(gui,color_select_bg) \
                           # -selectforeground $config(gui,color_select_fg)\
                           

  set lbw [multilist $glob(win,$inst).frame_listb config(ListBoxColumns,$inst) \
	       -toptions " -relief {ridge} \
                           -bd 0\
                         " \
	       -loptions " -relief {ridge} \
                           -selectmode extended \
                          " \
	       -boptions "-bitmap @$glob(lib_fr)/bitmaps/toggle.bit \
                          -command \"ToggleSelect $inst\" \
                          -bd 1 -height 12"\
               -font $config(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(gui,color_xx,winlist) {
    if {[string match "$lbw.*" $entry] } continue
    lappend newcolorlist $entry 
  }
  set glob(gui,color_xx,winlist) $newcolorlist
  
  set newtablist {}
  foreach entry $glob(gui,tablist) {
    if {[string match "$lbw.*" $entry] } continue
    lappend newtablist $entry
  }
  foreach winn $config(ListBoxColumns,$inst) {
    set swin [lindex $winn 0]
    set wd $lbw.$swin
    lappend glob(gui,color_xx,winlist) $wd $lbw.label$swin
    balloonhelp_for $lbw.label$swin {[_b "List box entry labels." ]}
    
    balloonhelp_for $wd \
	{[_b "Dir list box. Button bindings:\n<Tab>\
         \t\tMove focus to other window
         \n<Shift Left Mouse>\
         Extend selection from last single selected entry\n<Cntl Left Mouse>\
         \tAdd the file under the mouse to the selection\n<drag Left Mouse>\
         Add files moved over to the selection\n<char>\
         \t\tScroll window to make files that start with\n\
         \t\t<char> visable.  If control <char> or 'Position to\n\
         \t\tdirectories' scroll to make directory entry visable\
         \n\n Mouse buttons 1, 2, & 3 combinations are\n\
         \tConfigurable see 'Mouse Bindings & menus'\n\
         " ]}
    # Bind the buttons
    bind $wd <Tab> "focus [OpName $wd];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"
    foreach {but val} [array get config "bind,*"] {
      set button [regsub {bind,(.*)} $but {\1}]
      catch {bind $wd <$button> {} }
      if {[catch {
	bind $wd <$button> "DoBut $button ${inst} \[$wd nearest %y\] %X %Y
                            break"}  out] != 0 } {
	if {$inst == "left" } {
	  # only complain about this on one of the panes
	  lappend err  [list $button $out]
	}
      }
      
    }

    #bind $wd <ButtonRelease-1> "+UpdateStat"
    #bind $wd <ButtonRelease-2> "+UpdateStat"

    if {$config(keyb_support)} {
      #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
        "
      bind $wd <KeyPress>  "DoCommandOnKey $inst %A"
    } else {
      bind $wd <KeyPress> "ShowListOnKey $inst %A"
    }
  }
  balloonhelp_for $glob(win,$inst).frame_listb.v.but \
      {[_b "Toggle the selection(s)." ]}
  pack $glob(win,$inst).frame_listb -side top -fill both -expand 1
  if {[info exists err]} {
    set errlist [lsort -unique $err]
    foreach ent $errlist {
      lassign $ent button out
      puts "$ent $button $out"
      PopError [_ "In trying to bind '%s' in $inst list box \
                \nerror '%s' occured. \
                 \n Skipping this binding." $button $out]
    }
  }
}
#---------- 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 {$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 seperate 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
}
# This routine (GetDirList) returns a sorted list of files in the current
# working dir
proc GetDirList { inst } {
  global config glob
  global ftp
  set directory $glob($inst,pwd)
  set result {}
  set sortlist {}
  set dl {}
  set type ""

  if { [IsFTP $directory] } {
 #   regexp {[a-z]?ftp://([^/]*)(.*)} $directory match ftpI directory
    # cancel notify if to this pane
    if {$glob(notify,$inst) != "" } {
      if {$glob(notify,left) != $glob(notify,right) } {
	catch {$glob(notify,watchname) remove $glob(notify,$inst)}
      }
      set  glob(notify,$inst) ""
    }
    
    set dummy {{0 {Can't get file list, try again?} n 0 0 0 0 0}}
    frputs "Get dir  " ftpI directory
    set r [catch {FTP_CD $ftpI $directory} outp]
    if {$r != 0} {
      PopError $outp
      return $dummy
    }
    set r [catch {FTP_List $ftpI $config(fileshow,all)} dirlist]
    if {$r != 0} {
      PopError $dirlist
      return $dummy
    }

    # Example of output (now placed in outp)
    #total 3333 (optional)
    #drwxrwxr-x   8 root     wheel        1024 Mar 16 14:28 .
    #drwxrwxr-x   8 root     wheel        1024 Mar 16 14:28 ..
    #lrwxrwxrwx   1 root     root           11 Mar 16 14:28 apa -> welcome.msg
    #drwxrwxr-x   2 root     wheel        1024 Dec  3  1993 bin
    #drwxrwxr-x   2 root     wheel        1024 Aug 30  1993 etc
    #drwxrwxr-x   2 root     wheel        1024 Dec  3  1993 incoming
    #drwxrwxr-x   2 root     wheel        1024 Nov 17  1993 lib
    #drwxrwxr-x   3 root     wheel        1024 Mar 10 16:08 pub
    #drwxrwxr-x   3 root     wheel        1024 Aug 30  1993 usr
    #-rw-r--r--   1 root     root          312 Aug  1  1994 welcome.msg

    # from android... ls -l  (nasty nil size on l & d also messy dev entries)
    #lrwxrwxrwx root     root              2012-02-14 10:23 vendor -> /system/vendor
    #lrwxrwxrwx root     root              2012-02-14 10:23 d -> /sys/kernel/debug
    #lrwxrwxrwx root     root              2012-02-14 10:23 etc -> /system/etc
    #-rw-r--r-- root     root         3882 1969-12-31 17:00 ueventd.rc
    #-rw-r--r-- root     root          890 1969-12-31 17:00 ueventd.omap4430.rc
    #-rw-r--r-- root     root            0 1969-12-31 17:00 ueventd.goldfish.rc
    #drwxr-xr-x root     root              2012-02-10 20:38 system
    #drwxr-xr-x root     root              2012-02-14 10:23 sys
    #crw------- root     root       4,  67 2012-02-14 10:23 ttyS3
    #crw------- root     root       4,  66 2012-02-14 10:23 ttyS2

    #wuarchive.wustl.edu:
    #-rw-r--r--   1 0                      605 Sep 27 14:45 README.NFS
    #-rw-r--r--   1 0                      474 Sep 27 14:45 README.SIMTEL
    #lrwxrwxrwx   1 0                        9 Sep 26 12:56 bin -> ./usr/bin

    #ftp://reactor.actlab.com (Yucky WinNT output)
    #12-02-97  02:17AM       <DIR>          !Incoming
    #06-03-97  09:38PM       <DIR>          !support
    #06-03-97  09:38PM       <DIR>          7thlevel
    #06-03-97  09:38PM       <DIR>          access
    #06-03-97  09:38PM       <DIR>          accolade
    #06-03-97  09:39PM       <DIR>          Activision
    #09-11-96  07:10PM                 3592 ACTlogo.gif
    #06-03-97  09:40PM       <DIR>          Apogee
    #06-03-97  09:40PM       <DIR>          avalon
    #06-03-97  09:40PM       <DIR>          beam


    set sortval_d [switch -exact $config(fileshow,dirs) {
      dirsfirst {expr {0}}
      mixed     {expr {1}}
      dirslast  {expr {2}}
    }]
    set linkfound 0
    foreach k $dirlist {
      if { $k == "" } continue
      if { [string range $k 0 4] == "total" } continue

      set filetype fn
      set link {}
      set nlinks {}
      # Try regular parsing

      frputs "$k "

      set r [regexp {^([^ ])([^ ]+) *([0-9]+) +([^ ]+) +([^ ]+) +([0-9]+)\
			 +(............) (((.+) -> (.+))|(.+))} \
		 $k match type flags nlinks owner group size date i1 i2 i3 i4]
      #  set r [regexp {^([^ ])([^ ]+) (*[0-9]+) +([^ ]+) +([^ ]+) +([0-9]+) \
      #	  +(............) (((.+) -> (.+))|(.+))} 
      # $k match type flags nlinks owner group size date i1 i2 i3 i4]

      set nlinks [string trim $nlinks]

      if {$ftp($ftpI,debug) } {
	#	puts "back from try regular dir"
      }
      if {!$r} {
#	puts "failed regular, trying andriod"
	frputs "Parse list " k
	set r [regexp {^([^ ])([^ ]+) ([^ ]+) +([^ ]+) (.*)\
			   ([0-9]{4}-[0-9]{2}-[0-9]{2}\
			   [0-9]{2}:[0-9]{2}) (((.+) -> (.+))|(.+))} \
		   $k match type flags owner group size date i1 i2 i3 i4]
	#                type  flags   owner group size date file link|file
	# if that worked, fix up the size...
	if {$r} {
	  if {$type != "-" } {
	    set size 0
	  } else {
	    set size [string trim $size]
	  }
	}
      }
      frputs "Parse list result " r date i1 i2 i3 i4 
      if {!$r} {
#	puts "android failed..."
	# Try wuarchive.wustl.edu parsing
	if {$ftp($ftpI,debug) } {
	  #	  puts "try wuarchive.wustl.edu dir"
	}
	set r [regexp {^([^ ])([^ ]+) (.*[0-9]+) +([^ ]+) +([0-9]+)\
			   +(............) (((.+) -> (.+))|(.+))} \
		   $k match type flags nlinks owner   size date i1 i2 i3 i4]
	if {!$r} {
	  
	  # Try WinNT parsing
	  if { $ftp($ftpI,debug) } {
 	    Log [_ "try WinNT dir"]
	  }
	  
	  set \
	      r \
	      [regexp \
		   {(.................)(......................)(.+)} \
		   $k match date type i1]
	  if {!$r} {
	    PopError [_ "Error parsing ftp LIST output: %s" $k]
	    return $dummy
	  }
	  set i3 {}
	  set type [string trim $type]
	  set flags rwxrwxrwx
	  set nlinks 1
	  set owner 0
	  set group 0
	  if {$type == "<DIR>"} {
	    set size 0
	    set type d
	  } else {
	    set size $type
	    set type n
	  }
	}
	set group 0
      }

      if {"$i3" != ""} {
	set file [string trimright $i3 "\n"]
	set link [string trimright $i4 "\n"]
      } else {
	set file [string trimright $i1 "\n"]
      }

      #	    if {"$file" == "." || "$file" == ".."} continue
      if {$type == "-"} { set type n}
      switch -exact $type {
	d  { set filetype fd }
	l  { 
	  if { $config(ftp,fastlink) == 1 } {
	    set r [catch {FTP_IsDir $ftpI "$directory/$file"} outp]
	    set linkfound 1
	    if { $r != 0 } { PopError [_ "Fatal error: %s" $outp]; CleanUp 1 }
	    if {$outp == 0} {
	      set filetype fl
	    } else {
	      set filetype fld
	      set link $outp
	    }
	  } else {
	    set filetype fld
	  }
	}
	c  -
	s  -
	p  -
	n  { set filetype fn }
	default { PopError [_ "Error parsing ftp LIST output: %s" $k]; \
		      return $dummy }
      }
      set sec [FTPDateStringToSeconds $date]
      set tmp [switch -exact $config(fileshow,sort) {
	time      {format "%011d" $sec }
	rtime     {format "%011d" [expr 2147483647 - $sec]}
	size      {format "%011d" $size }
	extension {file extension $file }
	default   {expr { " "}}
      }]
 #     puts ">$tmp<"
      switch -exact $filetype {
	fn -
	fl  {set sortval 1$tmp}
	fd -
	fld {set sortval $sortval_d$tmp}
      }
      lappend dl [list $sortval $file $filetype $size \
		      $sec $flags \
		      $owner/$group \
		      $link $nlinks\
		      {} {}]
      lappend sortlist "$sortval $file"
    }
    if {$linkfound} {
      # make sure we leave the working dir in the right place
      catch {FTP_CD $ftpI $directory}
    }
    if {$ftp($ftpI,debug) } {
#      puts "$dl"
    }
  } else {
    # It is NOT ftp, following is normal local file processing.
    #puts "here"
    # need the '/' below to prevent misbehavior with 'c:' which, for some
    # reason is not the same as 'c:'.  
    # The '/' is ignored in other cases (we hope).
    set glob($inst,lasttime) [clock seconds]
    if {$directory == "<volume>"} {
      foreach dir [file vol] {
	if {[file exists $dir]} {
	  if {[string length $dir] > 1 && [string range $dir end end] == "/"} {
	    set dir [string range $dir 0 end-1]
	  }
	  lappend dirlist $dir
	}
      }
    } else {
      cd $directory/
      set glob($inst,lastmtime) [file mtime $glob($inst,pwd)]
      set r [catch {glob -nocomplain *} dirlist]
      if {$r} {
	return -code 1 $dirlist
      }
      if { $config(fileshow,all) } {
	# for reasons unknown -type hidden does NOT return .file where .file
	# is a link.  No other option on windows...
	if { $glob(os) == "Unix" } {
	  set r [catch {glob -nocomplain .*} dirlist2]
	} else {
	  set r [catch {glob -nocomplain -type hidden *} dirlist2]
	}
	if {$r} {
	  return -code 1 $dirlist2
	}
	set dirlist [concat $dirlist2 $dirlist]
      }
    }
    ClearCherryPicker $inst
    set sortval_d [switch -exact $config(fileshow,dirs) {
      dirsfirst {expr {0}}
      mixed     {expr {1}}
      dirslast  {expr {2}}
    }]

    foreach k $dirlist {
      if {[catch { file lstat "./$k" statinfo }] && \
	      [catch {file lstat $k statinfo}]} continue

      set filetype n

      if {($statinfo(mode) & 0170000) == 040000} {
	set filetype d
      }
      set linkname " "
      if {($statinfo(mode) & 0170000) == 0120000} {
	set filetype l
	catch {file readlink "./$k"} linkname
	if {[file isdirectory "./$k"]} {
	  set filetype ld
	}
      } else {
	# check if it is a windows ".lnk" file
	if {[file extension "./$k"] == ".lnk"} {
	  if {[catch "LnkFile {./$k} to dir" out] == 0 && $out} {
	   set filetype [expr {$dir ? {wld} : {wl}}]
	   set linkname $to
	  }	  
	}
      }
      set tmp [switch -exact $config(fileshow,sort) {
	time      {format "%011d" $statinfo(mtime) }
	rtime     {format "%011d" [expr 2147483647 - $statinfo(mtime)]}
	size      {format "%011d" $statinfo(size) }
	extension {file extension $k}
	default   {expr { " "}}
      }]
      switch -exact $filetype {
	wl -
	n  -
	l  {set sortval 1$tmp}
	d   -
	wld -
	ld  {set sortval $sortval_d$tmp}
      }
      lappend dl [list $sortval $k $filetype $statinfo(size) \
		      $statinfo(mtime) [GetStringFromMode $statinfo(mode)] \
		      [GetUidGidString $directory/$k \
			   $statinfo(uid) $statinfo(gid)] \
		      $linkname $statinfo(nlink)\
		      $statinfo(atime) $statinfo(ctime)]
      lappend sortlist "$sortval $k"
    }
  }
  foreach el [lsort $config(sortoption) -indices $sortlist] {
    lappend result [lindex $dl $el]
  }
  return $result
}

# 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]
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"
}

# From a file-list (GetDirlist) construct a list suitable for displaying in the
# listbox
#
# Each element of the DirList (i.e. column) has a transformation formula
# to convert it.  The formula is a script and is kept in a config entry:
# config(lbscript,<lbname>).
#
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"
    # asseble the bits the scripts will need.
    #lassign $k sortval file type size mtime mode usergroup link nlink atime ctime
    lassign $k {*}$glob(fListEl)
    set ffile $file[switch -glob -- $type {
      *ld {expr {"@/"}} 
      *d  {expr {"/"}} 
      *l  {expr {"@"}} 
      *n  {expr {""}} 
    }]
#    set fmtime [GetTimeFromSecs $mtime]
#    set fmode [GetStringFromMode $mode]
#    set fuser [GetUidGidString $dir/$file $uid $gid]
    foreach lbentry $config(ListBoxColumns,$inst) {
      set flist [lindex $lbentry 0]
      lappend glob($inst,lv$flist) [eval $glob(lbscript,$flist)]
#	  puts "$flist $element $fmtime >$link<"
    }
  }
#  return $glob($inst,dirl)

}

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 { 1 } {
    set dir [lindex  $glob($inst,dirstack) 0 0]
 #   set pos [lindex [lindex $glob($inst,dirstack) 0] 1]
     if  {$dir != ""} {
      if {$dir == $glob($inst,pwd)} {
        if {[llength $glob($inst,dirstack)] == 1} break
        set glob($inst,dirstack) [lrange $glob($inst,dirstack) 1 end]
        continue
      }
      NewPwd $inst $dir
      UpdateWindow $inst
      set glob($inst,dirstack) [lrange $glob($inst,dirstack) 2 end]
      break
    }
    error [_ "Internal error, dir is null"]
    break
  }
  #puts "back: $glob(left,dirstack)\n$glob(right,dirstack)\n"
}

proc UpdateWindow { inst } {
  global glob
  if {$glob(async)} 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
}

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 {![IsFTP $glob($inst,pwd)]} {
    set glob($inst,df) [GetDF $glob($inst,pwd)]
  } else {
    # Don't know for ftp 
    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 fourced update and old==new, just update entry_dir
  if { [IsFTP $glob(${inst},pwd)] && (!$glob(forceupdate)) } {
    if {$glob(${inst},update_oldpwd) == $glob(${inst},pwd)} {
      $glob(win,$inst).entry_dir delete 0 end
      $glob(win,$inst).entry_dir insert end $glob(${inst},pwd)
      $glob(win,$inst).entry_dir xview end
      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)
  } else {
    if {[IsFTP $glob($inst,pwd)] && $glob(forceupdate) } {
      FTP_InvalidateCache $ftpI $directory
    }
    set r [catch {GetDirList $inst} glob(${inst},filelist)]
  }
  if {$r != 0} {
    PopError [_ "Updating %s panel:\
              Error reading directory %s :\
              %s" $inst $glob(${inst},pwd) $glob(${inst},filelist)]
    # This does work for Windows gives root on current volumn
    NewPwd $inst /
    set r [catch {GetDirList $inst} glob(${inst},filelist)]
    if {$r != 0} {
      PopError [_ "Fatal error: Cannot change to root directory. DON'T PANIC"]
      CleanUp 1
    }
  }

  $glob(win,$inst).entry_dir delete 0 end
  $glob(win,$inst).entry_dir insert end $glob(${inst},pwd)
  $glob(win,$inst).entry_dir xview end

  # 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 {
    ConstructFileList $inst
  }
  # 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 {
    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 {($config(keyb_support) || 1) && \
	      [$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)
}

proc GotoNewDir { inst { ask 0 } } {
  global glob
  if { ! $ask } {
    set newdir [$glob(win,$inst).entry_dir get]
  } else {
    set newdir ""
  }
  DoProtCmd { 
    NewPwd  ${inst} $newdir $ask
    UpdateWindow ${inst}
  }
  focus .
}



#  set newdir [GetNewDir $inst $ask]
#  if {$newdir == ""} return
#  DoProtCmd {
#    NewPwd ${inst} $newdir
#    UpdateWindow ${inst}
#  }
#}

proc GetNewDir {inst } {
  global glob ignor_error_flag


  set info  [_ "File runner choose directory"]
  set r 1
  while {$r != 0} {
    set ignor_error_flag [_ "Can not go there (permission?)"]
    set r [catch {tk_chooseDirectory -title $info \
		      -initialdir [$glob(win,$inst).entry_dir get] \
		      -mustexist 0} newdir]
    unset ignor_error_flag
#    set info "File runner - can't read $newdir (permission?)"
#    if { [file readable $newdir] == 0 } {
#      puts "can't read"
#      set r 1
#    }
  }
  if {[file isdirectory $newdir]} {
    return $newdir
  }
  return {}
}

# Here we selecte given item(s) by index
#
#  inst is one of {left right}
#  sel  is a list of entries to select
#
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)
  }
  $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)
  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
  }
}

proc InitBindings {} {
  global config glob

  foreach inst {left right} {
    bind $glob(win,$inst).entry_dir <Key> "set glob(whichdir) $inst"
    bind $glob(win,$inst).entry_dir <Return> "GotoNewDir $inst;break"
    bind $glob(win,$inst).entry_dir <KP_Enter> "GotoNewDir $inst;break"
    bind $glob(win,$inst).entry_dir <3> "GotoNewDir $inst 1;break" 
    bind $glob(win,$inst).entry_dir <Escape> " 
      DoProtCmd \"UpdateWindow ${inst}\"
      focus .
    "
    #bind $glob(win,$inst).entry_dir <B2-ButtonRelease> "Do_Paste_dir $inst B2"
    bind $glob(win,$inst).entry_dir <<Paste>> "Do_Paste_dir $inst"
  }
}
proc Do_Paste_dir { inst} {
  global glob
  set dir [clipboard get]
  # Do a normal paste if not a file (or not one we can look at)
  if {![file exists $dir]} {return}
  # if it is a link, get that...
  set r [catch "file link $dir" out]
  if {$r == 0 } {
    set dir [file join [file dirname $dir] $out]
  }
  DoProtCmd {
    GotoFind $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 [lrange $glob(cmds,list) 1 end] {
    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 $config(gui,color_highlight_bg)\
             -fg $config(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 n 0
  set s 0
  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 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
	}
	return 1
      }
    }
  }
  if {[llength $select]} {
 #   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)
  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.t.stat configure -text \
      "$n/$len = $s [lindex $glob($inst,df) 0]"
  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
}


proc ShowListOnKey { inst char } {
  global glob config
  if {$char == ""} return
  # set foc [focus]
  # switch -glob $foc {
  #   *entry* return
  # }
  # set inst ""
  # foreach in {left right} {
  #   if {[$glob(listbox,$in).file curselection] != ""} {set inst $in}
  # }
  # if {$inst == ""} return
  if {$config(fileshow,sort) != {nameonly} } {
    set ask [smart_dialog .apop .\
		 [_ "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
  }
  ShowListOnKey_ $glob(listbox,$inst).file glob($inst,filelist) "$char"
}

proc ShowListOnKey_ { listb_name filelist_var char } {
  global glob config
  upvar $filelist_var filelist
  set first ""
  set last ""
  set mask $config(positiondirs)
  # For control characters we use the lower case version and 
  # position as a directory entry.  We ignor the positiondirs in this case.
  if {[string is control $char]} {
    scan $char %c num
    set char [format %c [expr {$num + 96}]]
    set mask 1
  }
  set case [expr {$config(sortoption) == "-ascii" ? "" : "-nocase"}]
  set n -1
  foreach k $filelist {
    incr n
    if {[IsFile $k] ^ $mask } {
      switch [eval "string compare $case -length 1 {$char} {[lindex $k 1]}"] {
	1 { continue}
	0  { if {$first == ""} {set first $n}
	     set last $n
	     continue
           }
	-1  {
	     set last $n
	     break
	   }
      }
    }
  }
#  puts "first $first last $last n $n"
  if {$first != "" } {
    # 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) 
    if {$first > 60} {
      $listb_name see 0
    } else {
      $listb_name see end
    }
    $listb_name see [expr {($first + $last) / 2}]
    return
  }
  $listb_name see $n
}

proc IsFile { elem } {
  switch [lindex $elem 2] {
    l -
    n -
    fl -
    fn { return 1 } 
  }
  return 0
}


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

# If you understand how these functions work, let me know. I haven't got
# the slighest idea anymore :-)

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

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

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

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

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

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


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

proc DoBut {which inst index X Y} {
  global glob config
  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
  }   
  if {$isocmd == "RaiseMenu" } {
    tk_popup $parm $X $Y
#    puts "Raiseing menu $inst"
    return
  }
  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} {ViewDirOpposite ViewDirOpposite} \
    {{UpDirTree $inst $X $Y} {UpDirTree $inst $X $Y}} {{Back $inst} {Back $inst}}

# 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)
#  puts "Viewone $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] $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) } {
    Log [_ "%s aborted" $info]
    #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) } "" 1
  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) } "" 1
  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 . "!" \
	   [list {} $file [_ " is not owned by you.\
                         \nOK to go ahead and try to %s anyway?" $action ]]\
	   0 2 \
	   [list [_ "Yes"] [_ "No"]]]
  if {$r == 0} {return 1}
  return 0
}
proc FtpCheckSyntax { inst newpwd} {
  global glob config
  upvar newpwd newdir
  set newdir $newpwd
  set beenhere 0
#  puts "$newdir"
  while { 1 } {
    set r [regexp {([a-z]?)ftp://([^/]*)(.*)} $newdir match sftp ftpI newpwd2]
#    puts "yet? match $match sftp $sftp ftpI $ftpI new $newpwd2 <"
    if {$r != 0 && $ftpI != "" && $newpwd2 == ""} { set newpwd2 / }
    if {$r == 0 || $ftpI == "" || $newpwd2 == ""} { 
      set \
	  newdir \
	  [EntryDialog "" \
	       [_ "Error in path"] \
	       [_ "Malformed URL %s\nFormat:\
                %sftp://<site>/<path>\n\
                 Please edit new path or cancel." $newpwd $sftp] \
	       $newpwd warning [buildDialogConfig]]
      if { $newpwd == "" || ! [IsFTP $newpwd]  } {
	# OK, the path was malformed and we got back nil, or a non-FTP path.
	# Go round again..
	return  -code continue $newdir
      }
      # Something that 'may' be a decent path, back up to test again...
      continue
    }
#    puts "$ftpI<>$sftp"
    set r [catch {OpenFTP $ftpI $sftp} out]
    if {$r} { 
      frputs "OpenFtp error " out
      if {$out == "ABORT_LOGIN" } {
	LogStatusOnly [_ "%sFTP login aborted" $sftp]
	set newdir ""
	return -code continue ""
      }
      if {$glob(debug)} {
	global errorInfo
	set info "\n errorInfo: $errorInfo"
      } else {
	set info ""
      }
      set newdir [EntryDialog  ""  \
		      [_ "Error Connecting"] \
		      [_ "Error: %s\n\nPlease edit new path or cancel." \
			   $out$info] \
		      $newdir warning [buildDialogConfig]]
      if { $newdir == ""  || ! [IsFTP $newdir] } {
	return  -code continue
      }
      # Still FTP but a new path, have another look here...
      continue
    }
    # Can we 'cd' to it?
    set r [catch {FTP_CD $ftpI "$newpwd2"} out]
#    puts "ftp cd to $newpwd2 ret= $r"
    if {$r || $out != 1 } { 
      # NO! 
      if {$beenhere == 1} {
	TryMakeNewDir $newdir
	incr beenhere
	continue
      }
      # See if s/he can help us with the path...
      if {$glob(debug)} {
	global errorInfo
	set info "\n errorInfo: $errorInfo"
      } else {
	set info ""
      }
#      puts "$r = r $out = out wd = $newpwd2"
      set newdir \
	  [EntryDialog ""  \
	       [_ "Error in path, can not cd to it"] \
	       [_ "Error: %s\nPlease edit new path or cancel.\
                 OK or Return will create it if it does not exist." $out$info] \
	       $newdir warning  [buildDialogConfig]]

      # The following is in order to make sure the connection 
      # to the FTP site is not lost even though we didn't get
      # the initial path correct.
    
      set r [catch {FTP_PWD $ftpI} out]
      if { $newdir == "" && ! $r} {
	set newdir [set sftp]ftp://$ftpI$out
      }
      if { $newdir == ""  || ! [IsFTP $newdir] } { 
	return -code continue
      }
      set beenhere 1
      continue
    }
    # Ok we can cd to the new path....
    break
  }

  # If we always want the true path, get that
  if { $config(ftp,cd_pwd) } {
    set r [catch {FTP_PWD $ftpI} out]
    if {!$r} {
      set glob(${inst},pwd) [set sftp]ftp://$ftpI$out
    } else {
      # not sure here.  we cd'd to the dir but failed the PWD???
      PopError "$out"
      set newdir "[set sftp]ftp://$ftpI$out"
      return -code continue 
    }
  } else {
    # Evaluate xxx/yyy/zzz/../.. to xxx
    while {[regexp -- {/\.\.$} $newpwd2]} {
      set newpwd2 [file dirname [file dirname $newpwd2]]
    }
    set glob(${inst},pwd) ftp://[set sftp]$ftpI$newpwd2
  }
  set newdir  $glob(${inst},pwd)
  return -code break
}


proc NewPwd { inst newpwd {ask 0} } { 
  global glob config

  set curdir $glob($inst,pwd)
  set info ""
  set tmp2 [string range $glob(${inst},newpwd_oldpwd) 0 5]
  set rqpwd $newpwd
 
  while { 1 } {
    if { ! [IsFTP $newpwd] } {
      # for reasons unknown file normalize will not remove the 
      # extra '/' in //foo, unless we add the '//.' at the end.
      set newpwd [file normalize  $newpwd//.]
    }
    if {  [IsFTP $newpwd] &&  ! $ask } {
      set mode ftp
      # The following returns continue or break as needed
      # It uses 'upvar' to set 'newpwd' with the desired value

      set newpwd [FtpCheckSyntax $inst $newpwd ]

      # End of ftp tests

    } else {
      if {$::tcl_platform(platform) == "windows"} {
	switch -regexp -nocase $rqpwd {
	  {^[a-z]:/\.\.$} {
	    set glob($inst,pwd) "<volume>"
	    return
	  }
	  {^<volume>/\.\.} {
	    set ask 1
	  }
	  {^<volume>/.*} {
	    set newpwd [string range $rqpwd 9 end]
	  }
	}
      }
      set mode normal
      if { $ask ||  $newpwd == "" &&  $curdir == "" } {
	     set newpwd [GetNewDir $inst]
	     if { $newpwd == "" && $curdir != "" } {
	       return
	     }
      } else {
	   # Its not an 'ask' so if the new is nil, just leave it all alone
	   if { $newpwd == "" } {
	     return
	   }
	 }
      #puts $newpwd
      # if newpwd is ?:/.. or /.. or //*/.. set the ask flag and go round again
      if {[regexp -nocase -lineanchor \
	       {^[a-z]:/\.\.$|^/\.\.$|^//[^/]+/[^/]+/\.\.$} \
	       $newpwd] == 1} {
	# Yep, lets ask via the menu
	set ask 1
	continue
      }
      set readable  [file readable $newpwd]
      set r [catch {cd "$newpwd"} out]
      if {$r || ! $readable } { 
#	     puts "failed read test"
        # Failed to be readable or cd able (or both). trying to get
	     # up the tree from the top??
        # Otherwise, we have a problem...
        set newpwd [EntryDialog ""  \
			  [_ "Error in path (not readable)"]\
		     [_ "Error: %s\nPlease edit new path or cancel.\
                      OK or Return will create it." $out] \
			$newpwd warning  [buildDialogConfig] ]
	     # If s/he returned cancel or abort or nil, if there 
	     # is an old path just return, else ... well insist...
        if {$newpwd == "" && $curdir != ""}  return ""
	TryMakeNewDir $newpwd
	set ask 0
        continue
      }
      if {$config(cd_pwd)  &&
	  [regexp -nocase -lineanchor \
		  {^[a-z]:/.*$|^/.*$|^//[^/]+/[^/]+/.*$} $newpwd] == 1} {
	set r [catch {frPwd} out]
	if {$r} { 
	  PopError [_ "Trying to get directory info: %s" $out]
	  if { $curdir != "" } return ""
	  continue
	}
	set newpwd $out
      } else {
	# Evaluate xxx/yyy/zzz/../.. to xxx
	set newpwd [file normalize $newpwd]
      }
      # Here is where we set the new dir in glob(inst,pwd)
      # We also want to use ?: rather than ?:/ so we do that here
      regsub -nocase {(^[a-z]:)/$} $newpwd {\1} glob(${inst},pwd)
      break
    }
  }
  # End of while

  if { [IsFTP $tmp2] } {
#    set r [regexp {[a-z]?ftp://([^/]*)(.*)} \
#	       $glob(${inst},newpwd_oldpwd) match \
#	       ftpI newpwd]
#    if { $r == 0 } { 
#      PopError [_ "Malformed URL %s (fatal)" $glob(${inst},newpwd_oldpwd)]
#      CleanUp 0 
#    }
#    CloseFTP $ftpI
  }

  set glob(${inst},newpwd_oldpwd) $glob(${inst},pwd)

  AppendToDirHistory $glob(${inst},pwd)
  # Moving to a new dir, clear watch on old if needed
  ClearWatch $inst $glob(${inst},pwd)

  #set oldy [lindex [$glob(listbox,$inst).file yview] 0]
  set oldy [$glob(listbox,$inst).file index active]
  set glob($inst,dirstack) \
    [linsert $glob($inst,dirstack) 0 [list $curdir $oldy]]
  if { [llength $glob($inst,dirstack)] > 110 } {
    set glob($inst,dirstack) [lrange $glob($inst,dirstack) 0 100]
  }
  #puts "back: $glob(left,dirstack)\n$glob(right,dirstack)\n"
}

proc AppendToDirHistory {dir} {
  global glob
  set found_index [lsearch -exact $glob(history) $dir]  
  if { $found_index == -1 } { 
    lappend glob(history) $dir
    set listlength [llength $glob(history)]
    if { $listlength > 32 } {
      set glob(history) \
	      [lrange $glob(history) [expr $listlength - 30] end ]
    }
    #puts "$glob(history)"
  } elseif { $found_index >= 0 } {
    set glob(history) [lreplace $glob(history) $found_index $found_index]
    # set list1 [lrange $glob(history) 0 [expr $found_index-1] ]
    # set list2 [lrange $glob(history) [expr $found_index+1] end]
    # set glob(history) [concat $list1 $list2]
    lappend glob(history) $dir
  }
}

proc CreateHistoryMenu { inst } {
  global glob
  set menun $glob(win,$inst).dirmenu_frame.history_but.m 
  $menun delete 0 end
  foreach dir $glob(history) {
    $menun add command -label "$dir" -command "CdHistory ${inst} \{$dir\}"
  }
}

proc CdHistory { inst dir } {
  global glob
  DoProtCmd "
    NewPwd ${inst} \{$dir\}
    UpdateWindow ${inst}
  "
}
proc CreateHelpMenu { } {
  global glob
  $glob(win,top).menu_frame.help_but.m delete 0 end

  $glob(win,top).menu_frame.help_but.m add command \
      -label [_ "QuickStart" ] \
      -command   { ViewText /usr/share/doc/filerunner/QuickStart.txt }
  $glob(win,top).menu_frame.help_but.m add command \
      -label [_ "User's Guide" ]\
       -command { ViewText /usr/share/doc/filerunner/Users_Guide.txt }
  $glob(win,top).menu_frame.help_but.m add command \
      -label [_ "Copying"]  -command { ViewText /usr/share/doc/filerunner/COPYING }
  $glob(win,top).menu_frame.help_but.m add command \
      -label [_ "History" ] -command   { ViewText /usr/share/doc/filerunner/HISTORY }
  $glob(win,top).menu_frame.help_but.m add command \
      -label [_ "Installation" ] -command   { ViewText /usr/share/doc/filerunner/README }
  $glob(win,top).menu_frame.help_but.m add command \
      -label [_ "FAQ" ] -command   { ViewText /usr/share/doc/filerunner/FAQ }
  $glob(win,top).menu_frame.help_but.m add command \
      -label [_ "Tips" ] -command   { ViewText /usr/share/doc/filerunner/Tips.txt }
  $glob(win,top).menu_frame.help_but.m add command \
      -label [_ "Known Bugs" ] -command   \
      { ViewText /usr/share/doc/filerunner/KnownBugs.txt }
  $glob(win,top).menu_frame.help_but.m add command \
      -label [_ "To Do" ] -command   \
      { ViewText /usr/share/doc/filerunner/To_Do.txt }
  if {[file exists $glob(conf_dir)/inotify-message]} {
    $glob(win,top).menu_frame.help_but.m add command \
	-label [_ "inotify" ] -command   \
      { ViewText  $glob(conf_dir)/inotify-message }
  }
}

proc CreateHotListMenu { inst } {
  global glob config
  Log [_ "creating %s" $inst]
  set menun $glob(win,$inst).dirmenu_frame.hotlist_but.m

  $menun delete 0 end
  $menun add command -label [_ "Dismiss"] -command \
      "$glob(win,$inst).dirmenu_frame.hotlist_but.m delete 0 end"
  $menun add separator
  $menun add command -label [_ "Add to hotlist"] -command \
      "AddToHotList \"\$glob($inst,pwd)\""
  $menun add separator
  set n 0
  foreach dir $glob(hotlist) {
    if { [lindex $dir 1] != "" } {
      if { [string index [lindex $dir 0] 0] == "-" } {
        # submenu
        catch {destroy $menun.$n}
        menu $menun.$n -tearoff false -font $config(gui,GuiFont)
        foreach sub [lrange $dir 1 end] {
          if { [lindex $sub 1] != "" } {
            $menun.$n add command -label "[lindex $sub 0]" -command \
		"CdHotList $inst \{[lindex $sub 1]\}"
          } else {
            $menun.$n add command -label "$sub" -command \
		"CdHotList $inst \{$sub\}"
          }
        }
        $menun add cascade -menu $menun.$n -label \
	    "[string range [lindex $dir 0] 1 end]"
        incr n
      } else {
        # commented menu
        $menun add command -label "[lindex $dir 0]" -command \
	    "CdHotList $inst \{[lindex $dir 1]\}"
      }
    } else {
      $menun add command -label "$dir" -command "CdHotList $inst \{$dir\}"
    }
  }
}

proc CdHotList { inst dir } {
  DoProtCmd "
    NewPwd $inst \{$dir\}
    UpdateWindow $inst
  "
}

proc AddToHotList { currentpwd } {
  global glob
  if {[lindex $currentpwd 1] != ""} {
    set currentpwd [list $currentpwd $currentpwd]
  }
  #puts "$currentpwd"
  lappend glob(hotlist) $currentpwd
}



#proc pvar { name element op } {
#  if { $element != "" } {
#    set name ${name} ($element)
#  }
#  upvar $name x
#  puts "Variable $name set to $x"
#}

proc ViewText { filename } {
  set r [catch {open $filename r} fid]
  if {$r != 0} {
    PopError "$fid"
    return
  }
# Check file size here and if LARGE, ask...
  set r [catch {read -nonewline $fid} content]
  if {$r != 0} {
    PopError "$content"
    catch {close $fid}
    return
  }
  close $fid
  ViewString [_ "Viewing %s" $filename] content $filename
}
proc undoHelp {w undo} {
  catch "destroy .apop"
  set r [catch "$w edit $undo" err]
  if {$r} {
    smart_dialog .apop $w {Info} [list {} $err] \
	0 0 {} [buildViewConfig]
  }

}
proc ViewString { title var_string filename } {
  global glob config
  upvar $var_string string

  incr glob(toplevelidx)  

  set w .toplevel_$glob(toplevelidx)
  toplevel $w
  wm title $w "$title"
  wm iconname $w "$title"
  wm geometry $w $config(geometry,textviewer)
  text $w.text \
      -relief sunken -bd 2 \
      -yscrollcommand "$w.fr.scroll set" \
      -setgrid 1 \
      -height 30 \
      -wrap word \
      -undo 1 \
      -font $config(gui,ListBoxFont) \
      -highlightthickness 0
  frame $w.fr -borderwidth 0
  scrollbar $w.fr.scroll -command "$w.text yview" 
  button $w.fr.quit -bitmap @$glob(lib_fr)/bitmaps/cross.bit -command \
      "destroy $w" -width 1 -height 11 -bd 1
  pack $w.fr.scroll -side bottom -fill y -expand 1
  pack $w.fr.quit -side top -fill x
  pack $w.fr -side right -fill y
  pack $w.text -expand yes -fill both
  $w.text insert 0.0 $string
  $w.text mark set insert 0.0
  $w.text edit reset
  destroy $w.text.p
   textSearch $w.text "$title" "+buildViewConfig" \
      [list [_ "Convert UTF-16"] "ReReadUTF16 $w.text [Esc $filename]"] \
      [list Undo "undoHelp $w.text undo" \
	   Redo  "undoHelp $w.text redo" \
	   {*}[spellCheckText $w.text -log LogStatusOnly -file $filename\
		   -filter $config(spellingFilter)]\
	   {Save As...} "SaveToFile $w.text [Esc $filename] 1" \
	  [_ "Save&Quit"] "SaveEditedText [Esc $filename] $w \"\"" \
	   [_ Quit]  "destroy $w"]
 
  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"
  return $w
}

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


proc AnchorTearoff {w menu tearoff } {
  global glob
# wm transient $tearoff $w
#  puts "$tearoff [wm state $tearoff] from $w menu $menu [wm geometry $menu]"
  # *@! MS windows, puts the tear off at +0+0.  Teach it what is right.
#  bind $tearoff <Unmap> "puts \"focus leaving\"; wm deiconify $tearoff "

  if {$glob(os) == "WIN32"} {
    lassign [winfo pointerxy $w] x y
    wm geometry $tearoff "+$x+$y"
    wm transient $tearoff $w
    wm  attributes $menu -toolwindow 1
  } else {
    ReplaceTearoff $w $menu $tearoff
  }
}
proc SaveToFile { w filename ask } {
  global env
  if {$ask} {
    if {$filename == ""} {set filename $env(HOME)/}
    set filename [EntryDialog $w [_ "What file?"]\
       [_ "Enter name of file to save to"] $filename question [buildDialogConfig]]
    if {$filename == ""} return
  } else {
    if {$filename == ""} {PopError [_ "Null filename"]}
  }
  Log [_ "Saving to %s" $filename]
  Try { set fid [open $filename w]
        puts -nonewline $fid [$w get 0.0 end]
        close $fid} "" 1
}

proc EditText { filename scriptWhenDone } {
  global glob config
  incr glob(toplevelidx)  

  set w .toplevel_$glob(toplevelidx)
  toplevel $w
  wm title $w [_ "Editing %s" $filename]
  wm iconname $w [_ "Editing %s" $filename]
  wm protocol $w WM_DELETE_WINDOW "EditTextCheckPoint\
       [Esc $filename] $w \"$scriptWhenDone\""
  wm geometry $w $config(geometry,qedit)

  text $w.text -relief sunken -bd 2 \
      -yscrollcommand "$w.fr.scroll set" -setgrid 1 \
      -highlightthickness 0 -height 30 \
      -undo 1 \
      -font $config(gui,ListBoxFont)
      # -background $config(gui,color_bg)\
      # -foreground $config(gui,color_fg)\
      # -selectbackground $config(gui,color_select_bg)\
      # -selectforeground $config(gui,color_select_fg)
  frame $w.fr -borderwidth 0
  scrollbar $w.fr.scroll -command "$w.text yview" 
  button $w.fr.quit -bitmap @$glob(lib_fr)/bitmaps/cross.bit\
      -command "EditTextCheckPoint [Esc $filename] $w \"$scriptWhenDone\"" \
      -width 1 -height 11 -bd 1
  pack $w.fr.scroll -side bottom -fill y -expand 1
  pack $w.fr.quit -side top -fill x
  pack $w.fr -side right -fill y
  pack $w.text -expand yes -fill both
  set fid [open $filename r]
  $w.text insert 0.0 [read -nonewline $fid]
  close $fid
  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]
  }
  $w.text mark set insert 0.0
  $w.text edit reset
  textSearch $w.text [_ "Edit %s" $filename] "+buildViewConfig" {} \
      [list  Undo "undoHelp $w.text undo" \
	   Redo  "undoHelp $w.text redo" \
	   {*}[spellCheckText $w.text -log LogStatusOnly -file $filename\
		   -filter $config(spellingFilter)]\
	   [_ "Save"]     "SaveToFile $w.text [Esc $filename] 0" \
	   {Save As...}    "SaveToFile $w.text [Esc $filename] 1" \
	   [_ "Save&Quit"] "SaveEditedText [Esc $filename] $w \"$scriptWhenDone\""\
	   [_ "Quit"]      "destroy $w"]
  bind $w <Escape> "EditTextCheckPoint [Esc $filename] $w \"$scriptWhenDone\""
  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"
}

proc EditTextCheckPoint { filename w scriptWhenDone } {
  set r [smart_dialog .editq . [_ "What to do?"]\
	     [list [_ "Do you want to save before exiting?"]]\
	     0 3 [list Yes No Cancel]]
  switch $r {
    0 { SaveEditedText $filename $w $scriptWhenDone }
    1 { catch { destroy $w } }
    default {}
  }
}

proc SaveEditedText { filename w scriptWhenDone } {
  Log [_ "Text editor: Saving %s" $filename]
  if {![Try { set fid [open $filename w]
        puts -nonewline $fid [$w.text get 0.0 end]
        close $fid} "" 1]} {
    catch {destroy $w}
  } else { }
  UpdateWindow both
  if {$scriptWhenDone != ""} {
    eval $scriptWhenDone
  }
}

proc TryMakeNewDir { newdir } {
  set r [regexp {[a-z]?ftp://([^/]*)(.*)}\
		 $newdir match ftpI dir]
      if {$r} {
        Try { FTP_MkDir $ftpI "$dir" } "" 1
      } else {
        Try { file mkdir $newdir } "" 1
      }
}
proc FTPEntryDialog { wm_title info_text start_entry } {
  global glob

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

proc ftpPwShow {} {
  global glob
  set showChar [expr {$glob(.ftp_showpw) ? {} : {*}}]
  .ftp_entry_dialog.1 config -show $showChar
}


proc EntryDialogDouble { wm_title info_text1 info_text2 info_text3 \
			     start_entry1 start_entry2 } {
  global glob config

  set w .tk_dialog_double
  toplevel $w -class Dialog
  set wt [winfo toplevel [winfo parent $w]]
  wm transient $w $wt
  wm title $w $wm_title
  wm iconname $w $wm_title
  wm resizable $w true false
  wm transient $w [winfo toplevel [winfo parent $w]]

  label $w.info_text -justify left -text $info_text1 -wraplength 7i
  pack $w.info_text -anchor w -side top -padx 8 -pady 5

  entry $w.entry \
      -highlightthickness 1 \
      -width 70 \
      -font $config(gui,ListBoxFont) 

      # -background $config(gui,color_bg) \
      # -foreground $config(gui,color_fg) \
      # -selectbackground $config(gui,color_select_bg) \
      # -selectforeground $config(gui,color_select_fg)
  $w.entry delete 0 end
  $w.entry insert end $start_entry1
  $w.entry xview end
  pack $w.entry -anchor w -side top -padx 8 -pady 4 -expand 1 -fill x

  label $w.info_text2 -text $info_text2 -justify left -wraplength 7i
  pack $w.info_text2 -side top -anchor w -padx 8 -pady 5

  entry $w.entry2 \
      -highlightthickness 1\
      -width 70 \
      -font $config(gui,ListBoxFont) 

      # -background $config(gui,color_bg) \
      # -foreground $config(gui,color_fg) \
      # -selectbackground $config(gui,color_select_bg) \
      # -selectforeground $config(gui,color_select_fg)
  $w.entry2 delete 0 end
  $w.entry2 insert end $start_entry2
  $w.entry2 xview end
  pack $w.entry2 -anchor w -side top -padx 8 -pady 4 -expand 1 -fill x

  label $w.info_text3 -text $info_text3 -justify left -wraplength 7i
  pack $w.info_text3 -side top -anchor w -padx 8 -pady 5

  button $w.ok -text [_ "OK"] -command {
    set glob(tk_dialog_double_return)\
	[list [.tk_dialog_double.entry get] [.tk_dialog_double.entry2 get]]
    destroy .tk_dialog_double
  }

  button $w.cancel -text [_ "Cancel"] -command {
    set glob(tk_dialog_double_return) {}
    destroy .tk_dialog_double
  }

  pack $w.cancel -side right
  pack $w.ok -side right

  set glob(tk_dialog_double_return) {}

  bind $w.entry <Return> {
    set glob(tk_dialog_double_return)\
	[list [.tk_dialog_double.entry get] [.tk_dialog_double.entry2 get]]
    destroy .tk_dialog_double
  }

  bind $w.entry <Escape> {
    set glob(tk_dialog_double_return) {}
    destroy .tk_dialog_double
  }

  bind $w.entry2 <Return> {
    set glob(tk_dialog_double_return)\
	[list [.tk_dialog_double.entry get] [.tk_dialog_double.entry2 get]]
    destroy .tk_dialog_double
  }

  bind $w.entry2 <Escape> {
    set glob(tk_dialog_double_return) {}
    destroy .tk_dialog_double
  }

  wm withdraw $w
  update idletasks
  set pw [winfo parent $w]
  set x [expr [winfo width $pw]/2 - [winfo reqwidth $w]/2 \
      + [winfo x $pw]]
  set y [expr [winfo height $pw]/2 - [winfo reqheight $w]/2 \
      + [winfo y $pw]]
  wm geom $w +$x+$y
  wm deiconify $w

  set oldFocus [focus]
  set oldGrab [grab current $w]
  frgrab $w
  focus $w.entry
  set oldena $glob(enableautoupdate)
  if {$oldena != 0 } {
    set glob(enableautoupdate) 0
  }
  tkwait window $w
  catch {focus $oldFocus}
  if {$oldGrab != ""} {
    frgrab $oldGrab
  }
  if { $glob(enableautoupdate) != $oldena } {
    set glob(enableautoupdate) $oldena
  }
  return $glob(tk_dialog_double_return)
}

proc FixFormatString { str } {
  global config
  # we do two things:
  # 1 for each element in the list 'str' replace the blanks with $config(space)
  # turn the resulting list into a simple string with no {}s
  # we do this with regsub to preserve any $ \ or [ in the string
  set newstr {}
  foreach el $str {
    set  newstr "$newstr [regsub -all { } $el $config(space)]"
  }
  set newstr [string range $newstr 1 end]
  return [regsub -all {\{|\}} $newstr {}]
}

proc ReSpaceString { prefix str {noq {}}} {
  global config
  # This does the invers of the above, taking a list apart and
  # entry at a time to remove the 'space' replacement chars.
  # prefix is usually set to 'exec' but you can use anything, even ""
  # if 'noq' is not {} quotes will not be added...  Otherwise, quotes
  # will be added if any spaces are found.

  set newstr $prefix
  foreach el $str {
    if {[regsub -all $config(space) $el { } nstr] != 0 && $noq == {}} {
      set newstr "$newstr \"$nstr\""
    } else {
      set newstr "$newstr $nstr"
    }
  }
  if {[string range $newstr 0 0] == " "} {
    return [string range $newstr 1 end]
  }
  return $newstr
}

# 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 origional 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}
  #puts "file is >$firstfile<"
  set found ""
  foreach k $config($extensionList,extensions) {
    foreach l [lindex $k 1] {
      if {[string match [string tolower $l] [string tolower "$firstfile"]]} {
        set found $k
        break
      }
    }
    if {$found != ""} break
  }
  if {$found != ""} {
    if {[lindex $k 2] == "-viewtext"} {
      foreach file $filenamelist {
	set ex [format [FixFormatString [lindex $k 0]] \
		    [FixFileName $file 1 {\[ $}]] 
	set cmd [ReSpaceString exec $ex] 
	Log "Running $cmd"
	#set out [{*}$cmd]
	catch $cmd out
        ViewString [_ "Viewing %s" $file] out ""
      }
    } else {
      # list needs to be escaped...
      foreach file $filenamelist {
	# the {} below prevent trying to do string or comand substution...
        lappend f2 [FixFileName $file 1 {\[ $}] 
      }
      set ex "[format [FixFormatString [lindex $k 0]] $f2] &"
      set cmd [ReSpaceString exec $ex]
      Log "Try $cmd"	
      Try $cmd "" 1
      # Try {eval eval eval exec [format [lindex $k 0] $f2] &} "" 1
    }
    return
  }
  
  # Ok, we did not trap it above.  Try the open trick. 
  if { $extensionList == "view" } {
    foreach filename $filenamelist {
      ViewText $filename
    }
    return
  }
  # 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
  foreach filename $filenamelist {
    incr index
    frputs "in viewany- open  " filename
    set file [FixFileName $filename 2 {\[ $} ]
    while {1} {	
      # this while is just so we can break... we always do
      frputs "ViewAny while  "
      if {[file executable  $filename ] && \
	      $::tcl_platform(platform) != "windows"} {
	# verify executable by checking mime type
	Log [ReSpaceString "exec file -b" "$file"]
	set r  [catch [ReSpaceString "exec file -b" "$file"] out]
	if {$r != 0} {break}
	if { [string match {*executable*} $out] && \
		 ![string match {*MS Windows*} $out]} {   
	  Log [ReSpaceString "exec" "$file &"]     
	  set r [catch  [ReSpaceString "exec" "$file &"] out]
	  break
	}
      }
      if {$::tcl_platform(platform) == "windows" && $filenameorg != {}} {
	# on windows, execute the original *.lnk if available
	set file [FixFileName [lindex $filenameorg $index] 2 {\[ $} ]
      }
      Log [ReSpaceString "exec $config(cmd,open)" "$file &"]
      set r [catch [ReSpaceString "exec $config(cmd,open)" "$file &"] out]
      break
    }
    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
  }
  set ex [format [FixFormatString [lindex $k 0]] [FixFileName $file 3 {\[ $}]]
  set cmd [ReSpaceString exec $ex]
  cd $dir

  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 . [_ "Info"] [list $info] 0 1 [_ "OK"]
  #LogSilent "**Info**\n$info"
}

proc PopWarn { warn } {
  smart_dialog .apop . [_ "Warning"] [list $warn] 0 1 [_ "OK"]
  LogStatusOnly "[lindex [split $warn \n] 0]"
  LogSilent [_ "**Warning**\n%s" $warn]
}

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

proc Clean {} {
  foreach win [winfo children .] {
    if {[string match ".toplevel_*" $win]} {
      destroy $win
    }
  }
}

proc PopError { error } {
  global glob errorInfo
#  tk_dialog_fr .apop "**Error**" "$error" "" 0 "OK"
#  Try view instead.  Doesn't truncate error messages, cutable, saveable
#  a "good thing" tm
#  Even more, lets use just one window for all error messages...
  set er ""
  if {![info exists glob(errorWindow)] || ![winfo exists $glob(errorWindow)]} { 
    set glob(errorWindow) [ViewString [_ "**Error**"] er ""]
#    puts "window name is >$glob(errorWindow)<"
    wm protocol  $glob(errorWindow) WM_DELETE_WINDOW \
	 PopErrorClean
    $glob(errorWindow).fr.quit configure \
	-command PopErrorClean
    # Rewrite the 'Quit' command to save the window
    $glob(errorWindow).text.p entryconfigure last \
	-command PopErrorClean
    $glob(errorWindow).text.p insert 1 command \
	-label {Clear error window} \
	-command "$glob(errorWindow).text delete 0.0 end"
    bind $glob(errorWindow)  <Escape> PopErrorClean
  }
  $glob(errorWindow).text mark set insert end
  $glob(errorWindow).text insert end "\n=============\n$error"
  if {$glob(debug)} {
    $glob(errorWindow).text insert end "\n==errorInfo==\n$errorInfo"
  }
  $glob(errorWindow).text see end
  wm withdraw $glob(errorWindow)
  wm deiconify $glob(errorWindow)
  $glob(errorWindow).text.p unpost
#  ViewString "**Error**" error ""
  LogStatusOnly "[lindex [split $error \n] 0]"
  LogSilent [_ "**Error**\n%s" $error]
}
proc PopErrorClean {} {
  global glob
  wm  withdraw $glob(errorWindow)
  # clean up any lingering tearoffs
  eval {eval [bind $glob(errorWindow) <Destroy>]}
} 
proc PopErrorSimple { error } {
  smart_dialog .apop . [_ "**Error**"] \
      [list $error] 0 1 [_ "OK"]
}

proc Try { tryscript excuse alsoPrintErrorInfo {async 0} } {
  frputs "Try: "  "tryscript"
  if {$async} {
    # Currently the try function can only background 
    # commands that use the built-in exec
    if {[string match "*exec*" $tryscript]} {
      set tryscript "$tryscript &"
    }
  }
  set r [catch {uplevel  [subst -nocommands -novariables $tryscript]} outp ]
  #set r [catch [subst -nocommands $tryscript] outp]
  frputs "Try " r outp
  if {$r == 0} {return 0}
  if {$::glob(abortcmd)} {
    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 == "child killed: write on pipe with no readers"} {
    return 0
  }

  if {$alsoPrintErrorInfo} {
    if {$excuse != ""} {
      PopError "$excuse\n$outp"
    } else {
      PopError "$outp"
    }
  } else {
    if {$excuse != ""} {
      PopError "$excuse"
    }
  }

  return 1
}

proc StartTerm { dir inst } {
  global config
#  puts "$dir $config(cmd,term)"
# might want to allow spaces in the term command>>>
  Try {cd $dir; eval exec [format $config(cmd,term) $dir] & } "" 1
}

# Make sure link is open, don't open it if it is already open
proc OpenFTP { ftpI sftp} {
  global glob config env
  set ftpIleft ""
  set ftpIright ""
  set rl [regexp {([a-z]?)ftp://([^/]*)(.*)} $glob(left,pwd) \
	      match lsftp ftpIleft directory]
  set rr [regexp {([a-z]?)ftp://([^/]*)(.*)} $glob(right,pwd) \
	      match rsftp ftpIright directory]
  if {$ftpIleft == $ftpI || $ftpIright == $ftpI} {
    # Link already open
    return ""
  }
  Log [_ "Opening %sFTP connection to %s" $sftp $ftpI]
  set pwmess [expr {$sftp == "s" ?\
			[_ "\n(For SFTP multi part passwords\
                           ('password' 'private key file' 'Passphrase')\
                           \nplease enclose the whole entry\
                            in braces {} see 8.8 in the users guide)\n"] : ""}]
  # first see if we can find a match in the config(ftp,site_usage) rule list
  set r 0
  foreach k $config(ftp,login) {
    if {[string match [lindex $k 0] $ftpI]} {
      set user [lindex [lindex $k 1] 0]
      set passwd [decript $env(USER) [lrange [lindex $k 1 1] 1 end-1]]
      set proxy [lindex $k 2]
      set initcmd [lindex $k 3]
      if {$passwd == "XXX"} {
        set t [FTPEntryDialog \
		   [_ "%sFTP Login:0" $sftp] \
		   [_ "Connecting to %s: Please enter password%s" $ftpI $pwmess]\
		   $user]
        if {$t == ""} {
          error "ABORT_LOGIN"
        }
        set passwd [lindex $t 1]
      }
      if { $passwd == "" } {
        set passwd $config(ftp,password)
      }
      if { $proxy != "" } {
        set r [catch {FTP_OpenSession \
			  $ftpI \
			  $sftp \
			  $proxy \
			  $user@$ftpI \
			  $passwd\
			  $ftpI \
			  $initcmd} out]
        set glob(ftp,$ftpI,host) $proxy
        set glob(ftp,$ftpI,passwd) $passwd
        set glob(ftp,$ftpI,user) $user@$ftpI
      } else {
        set r [catch {FTP_OpenSession \
			  $ftpI \
			  $sftp \
			  $ftpI \
			  $user\
			  $passwd \
			  $ftpI \
			  $initcmd} out]
        set glob(ftp,$ftpI,host) $ftpI
        set glob(ftp,$ftpI,passwd) $passwd
        set glob(ftp,$ftpI,user) $user
      }
      frputs "back from first open " r out
      if { $r == 0 } {
	Log [_ "%sFTP connection to %s open" $sftp $ftpI]
	return
      } else {
	break 
      }
    }
  }
  while { 1 } {
    global errorInfo
    if {! [info exists user]} {
      set user [expr {$glob(os) != "WIN32" ? $env(USER) : $env(USERNAME)}]
    }
    set passwd $config(ftp,password)
    frputs "open error " r out
    if { $r && (! [string match -nocase "*password*" $out] && \
		! [string match -nocase "*connecting*" $out]) } {
      return -code error $out
    }
    if { !$config(ftp,anonymous) } {
      if {$r && $glob(debug) } {
	set mess "$errorInfo \n  [_ "Connecting to %s:\
                   Please enter username and password" $ftpI]"
      } else {
	if {! $r} {
	  set out {}
	}
	set mess [_ "%sConnecting to %s:\
                   Please enter username and password$pwmess" $out $ftpI]
      }

      set t [FTPEntryDialog [_ "%sFTP Login:1" $sftp] $mess $user]
      if {$t == ""} {
	error [_ "ABORT_LOGIN"]
      }
      set user [lindex $t 0]
      set passwd [lindex $t 1]
      if { $passwd == "" } {
	set passwd $config(ftp,password)
      }
    } else {
      if { $r } {
	set mess [_ "Error: %s Connecting to %s:\
                   Please enter username and password$pwmess" $out $ftpI]
	set t [FTPEntryDialog [_ "%sFTP Login:2" $sftp] $mess $user]
	if {$t == ""} {
	  error [_ "ABORT_LOGIN"]
	}
	lassign $t user passwd
      }
    }
    if { $config(ftp,proxy) != "" && $config(ftp,useproxy)} {
      set r [catch {FTP_OpenSession $ftpI \
			$sftp $config(ftp,proxy) \
			$user@$ftpI \
			$passwd $ftpI ""} out]
      set glob(ftp,$ftpI,host) $config(ftp,proxy)
      set glob(ftp,$ftpI,passwd) $passwd
      set glob(ftp,$ftpI,user) $user@$ftpI
    } else {
      set proxy {}
      set r [catch {FTP_OpenSession $ftpI \
			$sftp \
			$ftpI \
			$user \
			$passwd \
			$ftpI "" } out]
      set glob(ftp,$ftpI,host) $ftpI
      set glob(ftp,$ftpI,passwd) $passwd
      set glob(ftp,$ftpI,user) $user
    }
    if {$r} continue
    set ask [smart_dialog .apop . [_ "Login sucessful."] \
		 [list [_ "Login sucessful.\
		     \nDo you want to save the name and password for site: \
                  \n%s" $ftpI]] 0 2 [list [_ "No"] [_ "Yes"]]]
    if {$ask != 1} break
    foreach k $config(ftp,login) {
      if {![string match [lindex $k 0] $ftpI]} {
	lappend new $k
      }
    }
    set config(ftp,login) [lappend new [list $ftpI [list $user $passwd] $proxy]]
    FixPasswords
    
    break
  }
  
  Log [_ "%sFTP connection to %s open" $sftp $ftpI]
}

proc getOldNewVersions {} {
  global glob
  set r [catch {source $glob(conf_dir)/version} out]
  if {$r} {
    set version 0.0.0
  }
  # Do the welcome to new version thing only if 
  # a new day...
  set oldv [format {%02s%02s%02s} {*}[split $version {.}]]
  set newv [format {%02s%02s%02s} {*}[split $glob(version) {.}]]
  return [list $oldv $newv]
}

proc ShowRev { } {
  global glob env
  lassign [getOldNewVersions] oldv newv
  if {$newv > $oldv} {
    About
    #  show the history on a new rev
      ViewText /usr/share/doc/filerunner/HISTORY
    set r [catch {
      set fid [open $glob(conf_dir)/version w]
      puts $fid "set version $glob(version)"
      close $fid
    }]
    if {$r} {
      PopWarn [_ "Cannot create %s/version" $glob(conf_dir)]
    }
  }
}

# Make sure link is closed, don't close if in use
proc CloseFTP { ftpI } {
  global glob config
  set ftpIleft ""
  set ftpIright ""
  set rl [regexp {[a-z]?ftp://([^/]*)(.*)} $glob(left,pwd) \
	      match ftpIleft directory]
  set rr [regexp {[a-z]?ftp://([^/]*)(.*)} $glob(right,pwd) \
	      match ftpIright directory]
  if {$ftpIleft == $ftpI || $ftpIright == $ftpI} {
    # Link in use
    return ""
  }
  #Log "Closing FTP connection to $ftpI"
  Try { FTP_CloseSession $ftpI } \
      [_ "Could not close FTP session nicely, (non-fatal)\n"] 1
  catch {unset glob(ftp,$ftpI,host)}
  catch {unset glob(ftp,$ftpI,user)}
  catch {unset glob(ftp,$ftpI,passwd)}
}


proc FindLibfr {} {
  global glob config env argv argv0 auto_path
  set possible [pwd]
  if { [catch {info script} out] == 0 } {
    if { [catch { file readlink $out} out1]  == 0 } {
      set out [file join [file dirname $out] $out1]
      set out [file normalize $out]
#      puts "normalize to $out from  $out1 pwd is [pwd]"
    }
    if { [catch {file dirname $out} it] == 0} {

      set tail [file tail $out]
#      puts "start with [info script]"
      set it [file normalize $it]
#      puts "found $it"
      set possible [concat $it $possible]
      # Wrap code requires we not have the drive letter...
      regsub {^[a-zA-Z]:/} $it {/} it
      set possible [concat $possible $it]
    }
  }
  set success 0
#  puts $possible
#  set foo {$possible [pwd] }
  foreach testfile $possible  {
#    puts "testing $testfile"
    if { [file exists $testfile/$tail]  == 1 } {
      set glob(lib_fr) $testfile
      set success 1
      break
    }
  }
  if { $success != 1} {
    puts [_ "Can not find fr library. Looked for %s in %s We quit!" \
	      $tail $possible]
    exit 1
  }
  #set glob(catch) [glob -nocomplain $glob(lib_fr)/packages/*]
  set auto_path [linsert $auto_path 0 \
		     $glob(lib_fr) \
		     $glob(lib_fr)/packages\
		     [file normalize ~/.fr]]
  # 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)] } {
	PopInfo [_ "Can not find document directory. Looked here\n%s\n\
                 %s\
                \nHelp menu items will fail..." $glob(lib_fr) $glob(lib_fr)/doc]
    }
  } else {
    if {![file readable /usr/share/doc/filerunner/HISTORY]} {
      PopInfo [_ "Document file %s is not readable \
              \n(possibly does not exist)\
              \nHelp menu items may fail... " /usr/share/doc/filerunner/HISTORY]
    }
  }
}

proc Log { text } {
  LogStatusOnly $text
  LogSilent $text
}

proc LogStatusOnly { text } {
    global glob
  if { [info exists $glob(win,top).status] == 0 } {
    $glob(win,top).status configure -text [string range $text 0 110]
    update idletasks
  } else {
#    puts "$text"
    PopError $text
  }
}
proc ViewLog {} {
  global glob env
  lappend glob(log_window) [ViewString [_ "Log"] glob(log) \
				$env(HOME)/filerunner.log]
}
proc LogSilent { text } {
  global glob config
  frputs "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
      }
    }
    set glob(log_window) $new
  }
}
# Since windows will do the right thing with '/'s in file names
# we no longer call the native file name thing.... Soooo much easier...

# This function fixes file names for exec calls 
# filel is assumed to be a file name.
# level 2 and above (to 5) do additional '\'s to allow deeper calls
# if 'ch' is provide each char in 'ch' is '\'ed as well. 
# also we replace blanks with $config(space) if ch != " " and sp == {}
# or sp is not provided

proc FixFileName { filel {level 1} {ch {}} {sp {}} } {
  global config
  set prostr [lindex {{} {} {\\\\} {\\\\\\\\} {\\\\\\\\\\\\\\\\} } $level]
  set result  $filel
  # [file nativename  $filel ]
  set flag 0
  if { $level != 0 } {
    regsub -all {\\} $result $prostr\\ result
    foreach char $ch {
      set rpc $prostr\\$char
      #puts "replace $rpc"
      regsub -all "\\$char" $result $rpc result
      if {$char == { }} {
	set flag 1
      }
    }
  }
  if { !$flag && $sp == {} } {
    regsub -all { } $result $config(space) result
  }
  #regsub -all {\[} $result $prostr\\\[ result
  if {$result != $filel } {
    Log [_ "FixFileName level %s morf %s -> %s" $level $filel $result]
  }
  return $result
}

# This returns true if dir is an FTP dir and also sets ftpI and directory,
# in the callers context
# false if not and does not set the vars.

proc IsFTP { dir } {
  return [uplevel regexp {\[a-z]?ftp://(\[^/]*)(.*)} \{$dir\} match ftpI directory]
}

# frPwd should filter /tmp_mnt stuff out of the path. 
# How well does that work? Not
# Really we just want to get the true path with out the links..
proc frPwd { } {
  global glob
  if { $glob(os) == "WIN32" } {
    return [pwd]
  }
  return [file dirname [file normalize [pwd]/x]]
}

proc CleanUp { ret } {
  global env config glob
  if {$glob(havedoneftp)} {
    set r [catch {glob $glob(tmpdir)/*} list]
    if {!$r && $list != "" } {
      catch { eval file delete -force -- $list } out
    }
  }
  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 {} {
  global config
  if { $config(dateformat) == "yymmdd" } {
    return "[clock format [clock seconds] -format %y%m%d\ %R]"
  } elseif {$config(dateformat) == "ddmmyy" } {
    return "[clock format [clock seconds] -format %d%m%y\ %R]"
  } else {
    return "[clock format [clock seconds] -format $config(dateformat)]"
  }
}

proc TimeUpdater {} {
  global glob
  $glob(win,top).menu_frame.clock configure -text "[Time]      "
  after 30000 TimeUpdater
}
proc NonLocalDir { dir } {
  # return 1 if not a local file system, else 0
  return  [catch "exec df -l $dir" ]
}

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 "ClearWatch1: " 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 "ClearWatch2: " 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
#  puts "clear $inst"
  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
  set f [focus]
  set class ""
  if {$f != ""} {
    set class [winfo class $f]
  }
  if {$glob(enableautoupdate)} {    # && $class != "Entry"
    foreach inst {left right} {
      if { ! [IsFTP $glob(${inst},pwd)] } {
        set r [catch { set mtime [file mtime $glob($inst,pwd)] }]
        if {!$r} {
          if {$mtime != $glob($inst,lastmtime)} {
            LogStatusOnly "Updating $inst panel"
            #DoProtCmd "UpdateWindow $inst"
	    DoProtCmd "updateInPlace $inst"
            LogStatusOnly "Updating $inst panel - done"
	    set did 1
            #set glob($inst,lastmtime) $mtime #done in updatewindow
          }
        }
      }
    }
  } else {
    trace remove variable glob(enableautoupdate) write WakeListUpdater
    trace add variable glob(enableautoupdate) write WakeListUpdater
  }
  if {$config(autoupdate)} {
    after [expr $config(autoupdate) * 1000] ListUpdater
  }
  return $did
}

proc StartUpdaters {} {
  global glob config
  after 30000 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
  if {[set i [lsearch -exact $argv -db]] != -1} {
    set argv [concat [lrange $argv 0 [expr $i - 1]] \
		  [lrange $argv [expr $i + 1] end]]
    set glob(debug) 1
  } else {
    set glob(debug) 0
    wm withdraw .
  }   
  #puts "here here $glob(debug)"
  set i [lsearch -exact $argv -iconified]
  
  if {$i < 0} {return 0}
  set argv [concat [lrange $argv 0 [expr $i - 1]] \
		[lrange $argv [expr $i + 1] end]]
  return 1
}

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


proc AddToBatchList { inst } {
  global glob
  foreach sel [$glob(listbox,$inst).file curselection] {
    set elem [lindex $glob($inst,filelist) $sel]
    switch [lindex $elem 2] {
      fl -
      fn {
        set item [list $glob($inst,pwd)/[lindex $elem 1] [lindex $elem 3]]
        set glob(batchlist) [linsert $glob(batchlist) end $item]
      }
      default {
        PopError [_ "You can only add FTP files to the batch"]
        return
      }
    }
  }
}

# The purpose of this function is to take a string and 
# escape it so it survives being passed through
# the evil eval command without changing at all. 
# (Did I mention I hate the eval command? :-) 
# ...I just realized I hate the list command too... :-)

proc Esc { name } {
  set a [list $name]
  set len [string length $a]
  # eval doesn't handle a string ending with '\ ' very well...
  if {[string range $a [expr $len - 2] end] == {\ }} {
    set a "\"$a\""
  }
  return $a
}

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 {} {
  global glob
  if {! $glob(debug)} {return}
  foreach ent $::startTimes {
    lassign $ent time mess
    if {![info exists st]} {
      set fr $time
      set st $time
    }
    frputs "[expr {$time - $st}]  $mess "
    set st $time
  }
  frputs "[expr {$time - $fr}] Total start time "
}

# ------------------------------STARTUP------------------------------------
#
lappend startTimes [list [clock milliseconds] "Begin start up"]
set glob(mbutton) 0
set glob(start_path) [pwd]
set glob(ftp,debug) 0
set glob(userMenuList) {}
#puts "about to do cmdline args"
set icon [CheckCmdLineArgs]
lappend startTimes [list [clock milliseconds] "After cmd line args"]
#puts "icon is $icon"
FindLibfr
lappend startTimes [list [clock milliseconds] "After finding libary"]

setupDebug $glob(debug)
lappend startTimes [list [clock milliseconds] "After debug setup"]

#puts "about to do set platform"

set glob(notify,Available) 0
set glob(inotify_flags) {}

global tcl_platform
#puts "set up inotify"
set glob(cygwin) {}
if { $tcl_platform(platform) != "unix" } {
  source $glob(lib_fr)/packageLinks.tcl
  set glob(os) WIN32
} else {
  set glob(os) Unix
  set OS $tcl_platform(os)
#  puts "test if linux"
  switch -nocase -glob $tcl_platform(os) {
    *cygwin* {
      set glob(cygwin) cygwin
    }  
    default {}
  }
}
set glob(notify,left) [set glob(notify,right) ""]
set glob(init_done) 0

#puts "about to do home"
if { ! [info exists env(HOME)] } {
  PopInfo [_ "Please define environment variable\
                  HOME (your home directory) and try again."]
  exit 1
} else {
  set glob(conf_dir)  [file normalize $env(HOME)/.fr]
#$glob(lib_fr)/userconfig 
}
#puts "about to do usercommands"
CheckConfigDir
lappend startTimes [list [clock milliseconds] "After check config dir"]

# Now the user commands and config stuff

set config(usercommands) ""
if { [file exists $glob(conf_dir)/cmds ] } {
  set r [catch { source $glob(conf_dir)/cmds } out]
  if { $r != 0 } {
    PopInfo [_ "Error loading code from %s/cmds:\n\n%s" $glob(conf_dir) $out]
    # Lets treat this as non-fatal...
  }
}
lappend startTimes [list [clock milliseconds] "After user commands setup"]
# Each entry consist of a label, the "-command", the variable and 
# the balloon help message
set fast_checkboxes {
  {{Expand Errors} {} glob(debug) {[_b "Toggles expanded error messages"]}}
  {{Balloon Help} {set ::balloon_help::enable $config(balloonhelp)} config(balloonhelp) \
       {[_b "Toggles the Balloon Help feature (what you are looking at)." ]}}
  {{Position to directories} {} config(positiondirs)\
       {[_b "Toggles the directory vs file positioning for characters typed \
             in a directory panel"]}}
  {{Show All Files} ForceUpdate config(fileshow,all) \
       {[_b "Toggles the show all files flag.\nIf\
            off 'hidden' files are not showen." ] }}
  {{Run Pwd After Cd} {} config(cd_pwd) \
       {[_b "Toggles the do pwd after cd flag" ]}}
  {{Run Pwd After Cd (FTP)} {} config(ftp,cd_pwd) \
       {[_b "Toggles the do pwd on FTP directroies after cd flag" ]}}
  {{Focus Follows Mouse} {after 1 "if {$config(focusFollowsMouse)== 1} \
                         {tk_focusFollowsMouse} "} \
       config(focusFollowsMouse) \
       {[_b "Toggles Focus Follows Mouse flag.\nTakes\
                effect immeadiatly if turned on. \nRequires\
                restart if turned off." ]}}
  {{Anonynomous Ftp}  {} config(ftp,anonymous) \
       {[_b "Toggles the Anonynomous FTP flag.\nIf \
           set FTP login is Anonynomous,\nelse \
           use rule based log in." ]}}
  {{Use FTP Proxy} {} config(ftp,useproxy) \
       {[_b "Toggles the FTP Proxy flag.  If set use Proxy." ]}}
}
if  {$tcl_platform(platform) != "windows" } {
  lappend fast_checkboxes \
      {{Create Relative Links} {} config(create_relative_links)\
       {[_b "Toggles the create relative links flag" ]}}
}

set glob(left,listhead) ""
set glob(right,listhead) ""
set glob(panelsLocked) 1
set glob(localCmds) [list cd history view type]
lappend startTimes [list [clock milliseconds] "After fast check box setup"]
FTP_InvalidateCache
InitConfig
lappend startTimes [list [clock milliseconds] "After init config setup"]
ShowWindow
lappend startTimes [list [clock milliseconds] "After main window build"]
ReadConfig
lappend startTimes [list [clock milliseconds] "After complete read config setup"]
ConfigPwd
StartUpdaters
lappend startTimes [list [clock milliseconds] "After updaters started"]
#after 1000
if {$icon != "1"} {
  wm deicon .
}
lappend startTimes [list [clock milliseconds] "After main window deiconify"]
if {$::tcl_platform(os) == "Linux"} { 
  after 1 setUpInotify
}
dumpStartTimes
unset icon
Log [_ "Welcome to FileRunner v%s.\
     Copyright (C) 2010-2012 Tom Turkey.\
     Copyright (C) 1996-1999 Henrik Harmsen." $glob(version)]
ShowRev
set glob(init_done) 1
set glob(program) [info script]
return


