#! /bin/sh
# -*- tcl -*- \
    exec wish "$0" "$@"

#set g }

set glob(version) "<20101228.2344.21>"
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} {return [::msgcat::mc $s]};

proc bgerror err {
  global errorInfo env glob tcl_patchLevel tk_patchLevel ignor_error_flag
  if {[info exists ignor_error_flag] } {
    set button [tk_dialog .bgerrorDialog "no-no" $ignor_error_flag \
		    error 0 "OK"]
    return
  }
   set info $errorInfo
  set button [tk_dialog .bgerrorDialog "Fatal error in Tcl Script" \
                  "You have found a bug. It might be in FileRunner.\n\
                   \n$err\n\nPlease send a bugreport to the author." \
                  error 0 "Exit" "See Stack Trace" "Prepare bugreport" "Ignor"]
  if {$button == 3} {
    return
  }
  if {$button == 0} {
    exit 1
  }
  if {$button == 2} {
    set r [catch {open $env(HOME)/filerunner_bugreport w} fid]
    if {$r} { 
      tk_dialog .bugrepinfo \
	  "Error" \
	  "Can't create file $env(HOME)/filerunner_bugreport to\
           dump bugreport\n$fid" \
	  "" 0 "Exit" ; exit 1}
    puts $fid "\nBugreport for FileRunner version $glob(version)\
                created [clock format [clock seconds]].\n"
    puts $fid "Please fill in/correct the rest of this and send\
               it to tomt@wildturkeyranch.net.\n\n"
    set r [catch { exec uname -a } output]
    if {$r} { set output "" }
    puts $fid "Operating System : $output"
    puts $fid "Tcl/Tk version   : $tcl_patchLevel / $tk_patchLevel"
    puts $fid "Comments         : "
    puts $fid "\nError string : $err"
    puts $fid "\nStack trace follows:\n--------------------\n$info"
    catch {close $fid}
    tk_dialog .bugrepinfo \
	"Error" \
	"Bugreport file saved to\n$env(HOME)/filerunner_bugreport.\
         Please fill in the rest of it and send it to the author." \
	"" 0 "Exit"
    exit 1
  }

  set w .bgerrorTrace
  catch {destroy $w}
  toplevel $w -class ErrorTrace
  wm protocol $w WM_DELETE_WINDOW { exit 1 }
  wm minsize $w 1 1
  wm title $w "Stack Trace for Error"
  wm iconname $w "Stack Trace"
  button $w.ok -text Exit -command "exit 1"
  button $w.ig -text Continue -command "return"
  text $w.text -relief sunken -bd 2 -yscrollcommand "$w.scroll set" \
      -setgrid true -width 60 -height 20
  scrollbar $w.scroll -relief sunken -command "$w.text yview"
  pack $w.ok -side bottom -padx 3m -pady 2m
  pack $w.scroll -side right -fill y
  pack $w.text -side left -expand yes -fill both
  $w.text insert 0.0 $info
  $w.text mark set insert 0.0

  # Center the window on the screen.

  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

  # Be sure to release any grabs that might be present on the
  # screen, since they could make it impossible for the user
  # to interact with the stack trace.

  if {[grab current .] != ""} {
    grab release [grab current .]
  }
}

proc ShowWindow {} {
  global glob tk_version argv argv0 config env win fast_checkboxes

  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
  frame $glob(win,top) -borderwidth 2 -relief raised
  # TOP LEVEL MENU BUTTONS
  frame $glob(win,top).menu_frame
  # File menu
  menubutton $glob(win,top).menu_frame.file_but \
      -menu $glob(win,top).menu_frame.file_but.m -text File
  balloonhelp_for $glob(win,top).menu_frame.file_but \
      [_ "Push it to see..." ]
  # Configuration menu
  menubutton $glob(win,top).menu_frame.configuration_but \
      -menu $glob(win,top).menu_frame.configuration_but.m \
      -text Configuration
  balloonhelp_for $glob(win,top).menu_frame.configuration_but \
      [_ "Push it to see..." ]
  # Utilities menu
  menubutton $glob(win,top).menu_frame.utils_but \
      -menu $glob(win,top).menu_frame.utils_but.m \
      -text Utilities
  balloonhelp_for $glob(win,top).menu_frame.utils_but \
      [_ "Push it to see..." ]
  # Help menu
  menubutton $glob(win,top).menu_frame.help_but \
      -menu $glob(win,top).menu_frame.help_but.m \
      -text Help
  balloonhelp_for $glob(win,top).menu_frame.help_but \
      [_ "Push it to see..." ]

  # Raised buttons
  frame $glob(win,top).menu_frame.fasync_cmds -bd 0
  # Stop button
  button $glob(win,top).menu_frame.fasync_cmds.abort \
      -borderwidth 1 \
      -text Stop \
      -command { set glob(abortcmd) 1 }
  balloonhelp_for $glob(win,top).menu_frame.fasync_cmds.abort \
      [_ "Attempts to abort a running async command" ]
  # Clone button
  button $glob(win,top).menu_frame.fasync_cmds.clone \
      -borderwidth 1 \
      -text Clone \
      -command Clone
  balloonhelp_for $glob(win,top).menu_frame.fasync_cmds.clone \
      [_ "Creats a clone of filerunner in the same dirs as this one." ]

  # Create FILE menu
  menu $glob(win,top).menu_frame.file_but.m -tearoff false
  $glob(win,top).menu_frame.file_but.m add command \
      -label About... \
      -command About
  $glob(win,top).menu_frame.file_but.m add command \
      -label "View Log..." \
      -command { ViewString "Log" glob(log) $env(HOME)/filerunner.log }
  $glob(win,top).menu_frame.file_but.m add command \
      -label Quit -command { CleanUp 0 }

  # Create CONFIGURATION menu
  menu $glob(win,top).menu_frame.configuration_but.m -tearoff false 
  $glob(win,top).menu_frame.configuration_but.m add command \
      -label {Save Configuration} -command SaveConfig
  $glob(win,top).menu_frame.configuration_but.m add command \
      -label {Edit Configuration...} -command ConfigBrowser
  $glob(win,top).menu_frame.configuration_but.m add command \
      -label {Reread Configuration} -command {
	ReadConfig;UpdateWindow both;Log "Configuration re-read"
      }
  $glob(win,top).menu_frame.configuration_but.m add separator

  $glob(win,top).menu_frame.configuration_but.m add check \
      -label "Balloon Help" -variable config(balloonhelp)
  $glob(win,top).menu_frame.configuration_but.m add check \
      -label "Show All Files" -variable config(fileshow,all) \
      -command ForceUpdate
  $glob(win,top).menu_frame.configuration_but.m add check \
      -label "Create Relative Links" \
      -variable config(create_relative_links) 
  $glob(win,top).menu_frame.configuration_but.m add check \
      -label "Run Pwd After Cd" -variable config(cd_pwd) 
  $glob(win,top).menu_frame.configuration_but.m 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...
  $glob(win,top).menu_frame.configuration_but.m add check \
      -onvalue 1 -offvalue 0 \
      -label "Focus Follows Mouse" -variable config(focusFollowsMouse) \
      -command {after 1 "if {$config(focusFollowsMouse)== 1} \
                         {tk_focusFollowsMouse} "}
  $glob(win,top).menu_frame.configuration_but.m add check \
      -label "Anonymous FTP" -variable config(ftp,anonymous) 
  $glob(win,top).menu_frame.configuration_but.m add check \
      -label "Use FTP Proxy" -variable config(ftp,useproxy) 
  $glob(win,top).menu_frame.configuration_but.m add separator
  $glob(win,top).menu_frame.configuration_but.m add radio \
      -label "Sort On Name" -variable config(fileshow,sort) \
      -value nameonly -command ForceUpdate
  $glob(win,top).menu_frame.configuration_but.m add radio \
      -label "Sort Dirs First" -variable config(fileshow,sort) \
      -value dirsfirst -command ForceUpdate
  $glob(win,top).menu_frame.configuration_but.m add radio \
      -label "Sort Dirs Last" -variable config(fileshow,sort) \
      -value dirslast -command ForceUpdate
  $glob(win,top).menu_frame.configuration_but.m add radio \
      -label "Sort On Time" -variable config(fileshow,sort) \
      -value time -command ForceUpdate
  $glob(win,top).menu_frame.configuration_but.m add radio \
      -label "Sort On Reverse Time" -variable config(fileshow,sort) \
      -value rtime -command ForceUpdate
  $glob(win,top).menu_frame.configuration_but.m add radio \
      -label "Sort On Size" -variable config(fileshow,sort) \
      -value size -command ForceUpdate
  $glob(win,top).menu_frame.configuration_but.m add radio \
      -label "Sort On Extension" -variable config(fileshow,sort)\
      -value extension -command ForceUpdate
  $glob(win,top).menu_frame.configuration_but.m add separator
  $glob(win,top).menu_frame.configuration_but.m add command \
      -label {Edit Entry BG Color...} -command "EditColor color_bg"
  $glob(win,top).menu_frame.configuration_but.m add command   \
      -label {Edit Entry FG Color...} -command "EditColor color_fg"
  $glob(win,top).menu_frame.configuration_but.m add command \
      -label {Edit Selection BG Color...} -command "EditColor color_select_bg"
  $glob(win,top).menu_frame.configuration_but.m add command \
      -label {Edit Selection FG Color...} -command "EditColor color_select_fg"
  $glob(win,top).menu_frame.configuration_but.m add command \
      -label {Edit Shell Cmd Color...} -command "EditColor color_cmd"
  $glob(win,top).menu_frame.configuration_but.m add command \
      -label {Edit Scheme Color...} -command "EditColor color_scheme"
  $glob(win,top).menu_frame.configuration_but.m add command \
      -label {Edit Cursor Color...} -command "EditColor color_cursor"
  $glob(win,top).menu_frame.configuration_but.m add command \
      -label {Edit Balloon Help FG Color...} \
      -command "EditColor color_balloonHelp_fg"
  $glob(win,top).menu_frame.configuration_but.m add command \
      -label {Edit Balloon Help BG Color...} \
      -command "EditColor color_balloonHelp_bg"
  $glob(win,top).menu_frame.configuration_but.m add command \
      -label {Edit List Box Font...} -command "EditFont ListBoxFont"
  $glob(win,top).menu_frame.configuration_but.m add command \
      -label {Edit Gui Font...} -command "EditFont GuiFont"
  $glob(win,top).menu_frame.configuration_but.m add command \
      -label {Edit Balloon Help Font...} -command "EditFont BalloonHelpFont"
  $glob(win,top).menu_frame.configuration_but.m add separator
  $glob(win,top).menu_frame.configuration_but.m add command \
      -label {Set Left Start Dir} -command "DoProtCmd \"SetStartDir left\""
  $glob(win,top).menu_frame.configuration_but.m add command \
      -label {Set Right Start Dir} -command "DoProtCmd \"SetStartDir right\""
  $glob(win,top).menu_frame.configuration_but.m add command \
      -label {Set Window Pos/Size} -command "SetWinPos"

  # Create Utilities menu
  menu $glob(win,top).menu_frame.utils_but.m -tearoff false 
  $glob(win,top).menu_frame.utils_but.m add command \
      -label {Swap Windows} \
      -command "DoProtCmd CmdSwapWindows"
  $glob(win,top).menu_frame.utils_but.m add command \
      -label {View As Text} -command "DoProtCmd CmdViewAsText"
  $glob(win,top).menu_frame.utils_but.m add command   \
      -label {What Is?...} -command "DoProtCmd CmdWhatIs"
  $glob(win,top).menu_frame.utils_but.m add command  \
      -label {Select On Contents...} -command "DoProtCmd CmdCSelect"
  $glob(win,top).menu_frame.utils_but.m add command  \
      -label {Run Command On Selected...} -command "DoProtCmd CmdRunCmd"
  $glob(win,top).menu_frame.utils_but.m add command  \
      -label {Check Size Of Selected...} -command "DoProtCmd CmdCheckSize"
  $glob(win,top).menu_frame.utils_but.m add command \
      -label {FTP Copy With Resume} -command {DoProtCmd {CmdCopy 1}}
  $glob(win,top).menu_frame.utils_but.m add command \
      -label {FTP Copy With Resume/Async} \
      -command {set glob(async) 1; DoProtCmd {CmdCopy 1}; set glob(async) 0}

  # Create Help menu
  menu $glob(win,top).menu_frame.help_but.m -tearoff false 
  $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 }
  # Lay out the menus on the top of the window
  pack $glob(win,top).menu_frame.file_but \
      $glob(win,top).menu_frame.configuration_but \
      $glob(win,top).menu_frame.utils_but \
      $glob(win,top).menu_frame.fasync_cmds -side left
  pack $glob(win,top).menu_frame.fasync_cmds.clone \
      $glob(win,top).menu_frame.fasync_cmds.abort -side left
  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]
	checkbutton $w.$n -variable [lindex $kk 2] \
	    -text "[lindex $k 1]" \
            -command "[lindex $kk 1]"
	balloonhelp_for $w.$n [expr [lindex $kk 3]]
	pack $w.$n -side left
	incr n
      }
    }
  }
  pack $glob(win,top).menu_frame.help_but -side right

  label $glob(win,top).menu_frame.clock -text "[Time]      "
  balloonhelp_for $glob(win,top).menu_frame.clock \
      [_ "Current date & time of day." ]
  pack $glob(win,top).menu_frame.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 $glob(win,top).menu_frame.user -text "root@$env(HOST)  "
  } elseif {$glob(os) != "WIN32"} {
    label $glob(win,top).menu_frame.user -text "$env(USER)@$env(HOST)  "
  } else {
    label $glob(win,top).menu_frame.user -text "$env(USERNAME)@$env(HOST)  "
  }
  balloonhelp_for $glob(win,top).menu_frame.user \
      [_ "Current user & machine names." ]
  pack $glob(win,top).menu_frame.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 \
      [_ "Status message line." ]

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

  # Build the left and right panels
  BuildFileListPanel left
  BuildFileListPanel right


  set darkcol [$glob(win,left).frame_listb.scroll_horiz cget -troughcolor]

  # build widget .fm
  frame $glob(win,middle) -borderwidth 2 -relief raised 
  # -bg $darkcol

  set glob(cmds,list)  { 
    { { ->      CmdToright "Dup left dir list in right." } 
      { <-      CmdToleft "Dup right dir list in left." } }
    { Copy      CmdCopy c 0 \
	  "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 \
	  "Copy selected file(s) to other dir with new name." } 
    { Delete    CmdDelete d 0 "Delete selected file(s)" }
    { Move      CmdMove m 0 "Move selected file(s) to other dir." }
    { Rename    CmdRename r 0 \
	  "Rename selected file(s).\nCan cause move." }
    { MkDir     CmdMakeDir "" 0 \
	  "Create new dir from modified dir line.\nIf\
           no modified dir line, prompts with\nleft dir as starter." } 
    { S-Link    CmdSoftLink s 0 "Create a symbolic link\
           to\nselected file(s) in other dir." }
    { S-LnAs    CmdSoftLinkAs "" 0 "Create a symbolic link to\
           selected\nfile(s) in other dir.\
           prompting for a\nnew name for each file." } 
    { Chmod     CmdChmod h 1 \
	  "Change the mode flags for selected file(s)." } 
    { View      CmdView v 0 \
	  "For dirs, go to the selected dir,\nfor\
           files, execute the rule selected\nprogram\
           with the selected file." }
    { Edit      CmdEdit e 0 \
           "Pass the selected file(s) to\nthe\
           user definded editor." } 
    { Q-Edit    CmdQEdit q 0 \
           "Pass the selected file(s) to\nthe\
            internal (tcl) editor." } 
    { Arc       CmdArc a 0 \
	  "Pass the selected file to the\n rule\
           defined archive program." } 
    { UnArc     CmdUnArc u 0 \
	  "Pass the selected file to the\n rule\
           defined unarchive program." } 
    { UnPack    CmdUnPack p 2 \
	  "Pass the selected file to the rule\ndefined\
           unpack/uncompress program." } 
    { ForEach   CmdForEach "" 0 \
	  "Run a selected (prompted for)\nprogram on\
          selected file(s." } 
    { Print     CmdPrint "" 0 \
	"Pass the selected files to the\nuser\
         defined print program." } 
    { Diff      CmdDiff f 2 \
         "Pass the last two selected files or\ndirs\
         (may both be in the same dir) to\nthe user\
         defined diff program." } 
    { Select    CmdSelect "" 0 \
         "After you enter a pattern\n in\
          one of the dir lines,\n selects\
          all matching files." } 
    { HardLnk   CmdHardlnk c 0 \
          "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 foo ""
  set savcon 0
  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) "$glob(cmds,list) $foo"

  set glob(cmds,cur) 0

  frame $glob(win,middle).top -borderwidth 0 -relief raised
  button $glob(win,middle).top.up -bitmap \
      @$glob(lib_fr)/bitmaps/pgup.bit -command "ShowCmds up"
  balloonhelp_for  $glob(win,middle).top.up \
      [_ "Move focus up to make upper buttons visable." ]
  button $glob(win,middle).top.down -bitmap \
      @$glob(lib_fr)/bitmaps/pgdown.bit -command "ShowCmds down"
  balloonhelp_for  $glob(win,middle).top.down \
      [_ "Move focus down to make lower command buttons visable." ]
  pack $glob(win,middle).top -side top -fill x
  pack $glob(win,middle).top.up -side left -expand 1 -fill both
  pack $glob(win,middle).top.down -side right -expand 1 -fill both
# the <- -> middle buttons...
  set n 0
  set c [lindex $glob(cmds,list) 0]
  frame $glob(win,middle).$n -bd 0
  button $glob(win,middle).$n.1 -bitmap \
      @$glob(lib_fr)/bitmaps/right.bit -command \
      "DoProtCmd [lindex [lindex $c 0] 1]"
  button $glob(win,middle).$n.2 -bitmap \
      @$glob(lib_fr)/bitmaps/left.bit -command \
      "DoProtCmd [lindex [lindex $c 1] 1]"
  pack $glob(win,middle).$n.2 -side left -expand 1 -fill x
  pack $glob(win,middle).$n.1 -side right -expand 1 -fill x
  pack $glob(win,middle).$n -side top -fill x
  incr n

  foreach b $config(middle_button_list) {
    if { [lindex $b 1] != "d"} {
      set cc [lsearch -index 0 -exact $glob(cmds,list) [lindex $b 0]]
      if { $cc != -1 } {
	set c [lindex $glob(cmds,list) $cc]
	set text [lindex $c 0]
	button $glob(win,middle).$n -text $text -command \
	    "set glob(mbutton) 1; DoProtCmd \"[lindex $c 1]\"" 
	balloonhelp_for $glob(win,middle).$n [_ [lindex $c 4]]
	foreach colentry $config(middle_button_colors) {
	  set name [lindex $colentry 0]
	  set col [lindex $colentry 1]
	  if { $text == $name } {
	    if { [string index $col 0] == "-" } {
	      $glob(win,middle).$n configure \
		  -activebackground [string range $col 1 end]
	    } else {
	      $glob(win,middle).$n configure \
		  -background $col -activebackground [LighterColor $col]
	    }
	  }
	}
	if {[lindex $c 2] != "" && $config(keyb_support)} {
	  $glob(win,middle).$n configure -underline [lindex $c 3]
	}
	bind $glob(win,middle).$n <3> \
	    "set glob(mbutton) 2;\
             set glob(async) 1; \
             DoProtCmd \"[lindex $c 1]\"; \
             set glob(async) 0"
	bind $glob(win,middle).$n <2> \
	    "set glob(mbutton) 3; DoProtCmd \"[lindex $c 1]\""
	pack $glob(win,middle).$n -side top -fill x
	incr n
      }
    }
  }

  # Build command windows
  BuildCmdWindow left
  BuildCmdWindow right

  pack .fupper -side top -fill both -expand 1
  pack .flower -side bottom -expand 1 -fill both
  pack $glob(win,top) -side top -fill both
  pack $glob(win,left) -side left -expand 1 -fill both
  pack $glob(win,right) -side right -expand 1 -fill both
  pack $glob(win,middle) -side top -expand 1 -fill y
  pack propagate .fupper 0
  pack forget $glob(win,bottom)
}

proc EditColor { color } {
  global config
#  catch {namespace eval $color "ColorEditor 0 0"}
#  catch {trace remove variable config(gui,$color) write ReConfigColors}
  
#  makeColorEditor $color
  set c $config(gui,$color)
  if {$c == ""} {set c [set config(gui,$color) grey85]}
#  trace add variable config(gui,$color) write ReConfigColors
  ColorEditor $color "global config;\
      set config(gui,$color) %%;ReConfigColors" $c
#  namespace eval $color \
      "ColorEditor {global config;set config(gui,$color) %%} $c"
#  trace remove variable config(gui,$color) write ReConfigColors
#  catch {namespace eval $color "ColorEditor 0 0"}
}


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)}
    }
    set glob(gui,ListBoxFont) $config(gui,ListBoxFont)
  }
}

# Produce a color suitable for active-backgrounds
proc LighterColor { color } {
  set color [winfo rgb . $color]
  foreach i {0 1 2} {
    set light($i) [expr [lindex $color $i]/256]
    set inc1 [expr ($light($i)*15)/100]
    set inc2 [expr (255-$light($i))/3]
    if {$inc1 > $inc2} {
      incr light($i) $inc1
    } else {
      incr light($i) $inc2
    }
    if {$light($i) > 255} {
      set light($i) 255
    }
  }
  return [format #%02x%02x%02x $light(0) $light(1) $light(2)]
}

proc ReConfigColors {args} {
  global glob config
#  puts "reconfigcolors"
  if {$config(gui,color_scheme) != $glob(gui,color_scheme) \
	  || $config(gui,color_cursor) != $glob(gui,color_cursor)} {
    catch {tk_setPalette background $config(gui,color_scheme) \
	       insertBackground $config(gui,color_cursor)} out
    set glob(gui,color_scheme) $config(gui,color_scheme)
    set glob(gui,color_cursor) $config(gui,color_cursor)
  }
  foreach c { color_bg color_fg color_select_bg color_select_fg } {
    if {$config(gui,$c) != $glob(gui,$c)} {
      foreach k $glob(gui,color_xx,winlist) {
        switch $c {
          color_bg { $k configure -bg $config(gui,$c) }
          color_fg { $k configure -fg $config(gui,$c) }
          color_select_fg { $k configure -selectforeground $config(gui,$c) }
          color_select_bg { $k configure -selectbackground $config(gui,$c) }
        }
      }
      set glob(gui,$c) $config(gui,$c)
    }
  }
  if {$config(gui,color_cmd) != $glob(gui,color_cmd)} {
    foreach k $glob(gui,color_cmd,winlist) {
      $k tag configure command -background $config(gui,color_cmd)
    }
    set glob(gui,color_cmd) $config(gui,color_cmd)
  }
  foreach bc { bg fg } {
    if {$config(gui,color_balloonHelp_$bc) \
	    != $glob(gui,color_balloonHelp_$bc)} {
      catch {.balloonhelp.info configure \
		 -$bc $config(gui,color_balloonHelp_$bc)}
      set $glob(gui,color_balloonHelp_$bc) $config(gui,color_balloonHelp_$bc)
    }
  }
}
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" \
      -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) \
      -width 70 \
      -height 30 

  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 \[lindex \{$result\} \[$w.top.list nearest %y\]\]\
       $inst $glob($inst,pwd);break"
  bind $w.top.list <B1-Motion> "break"
}

proc GotoFind { file inst dir } {
  global glob
  NewPwd $inst $dir/[file dirname $file]
  UpdateWindow $inst
  set j 0
  foreach i $glob($inst,filelist) {
    set name [lindex $i 1]
    if {$name == [file tail $file]} {
      $glob(win,$inst).frame_listb.listbox1 selection clear 0 end
      $glob(win,$inst).frame_listb.listbox1 selection set $j
      $glob(win,$inst).frame_listb.listbox1 see $j
      return
    }
    incr j
  }
  PopError "File $dir/$file can not be found"
}
#
# in linux info nameofex is full path to wish, argv0 is fr (possibly./fr)
# in windows wrap info nameofex is full path to fr.exe argv0 is same
# in windows no wrap info nameofex is full path to wish, argv0 is fr?
#
    # check if a warp  This is true if we found the lib
    # in a location without a *:/ in front
 #   regsub {^[a-zA-Z]:/} $glob(lib_fr) {/} it
 #   if {$glob(lib_fr) == $it} {
      # tried to remove the *: and got the same => it is a wrap
proc Clone  {} {
  global glob argv argv0
  set target [file normalize [info nameofex]]
  set script [file join $glob(start_path) $argv0]
  if { $target == $script} {
    set script ""
  }
  Try { cd  $glob(start_path); \
	    exec [FixFileName $target 1] \
	    [FixFileName $script 1 ] \
	    [FixFileName $glob(left,pwd) 1] \
	    [FixFileName $glob(right,pwd) 1] & } "" 1 
}
#

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)
    }
    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
    }
    $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"\
      -height $config(shell,height,$inst) \
      -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)
  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) \
      -background $config(gui,color_bg) \
      -foreground $config(gui,color_fg) \
      -selectbackground $config(gui,color_select_bg) \
      -selectforeground $config(gui,color_select_fg) \
      -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
  menu $w.text.p -tearoffcommand "AnchorTearoff $w" -title "Cmd $inst"
  $w.text.p add command \
      -label Search... \
      -command "SearchView $w.text 0"
  $w.text.p add command \
      -label {Search Again} \
      -command "SearchView $w.text 1"
  $w.text.p add command \
      -label {Save As...} \
      -command "SaveToFile $w.text {} 1 "
  #bind $w.bot.max <FocusIn> "focus $w.bot.entry"
  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> "Complete $inst $w;break"
  bind $w.bot.entry <Control-d> "CompleteShow $inst $w"
  bind $w.bot.entry <Control-p> "FlipShellHistory $w.bot.entry $inst searchback"
  bind $w.bot.entry <Control-c> "DoControlCthing $w $inst"
  bind $w.bot.entry <Up> "FlipShellHistory $w.bot.entry $inst up"
  bind $w.bot.entry <Down> "FlipShellHistory $w.bot.entry $inst down"
  bind $w.bot.entry <Enter> "focus $w.bot.entry"
  bind $w.bot.entry <Leave> "focus ."
  bind $w.text <3> "tk_popup $w.text.p %X %Y"
  bind $w.text <Enter> "focus $w.bot.entry"
  bind $w.text <Leave> "focus ."
  bind $w.text <FocusIn> "focus $w.bot.entry"
  bind $w.text $config(mwheel,neg) \
      "$w.text yview scroll \
       -$config(mwheel,delta) units"
  bind $w.text \
      $config(mwheel,pos) \
      "$w.text yview scroll \
       $config(mwheel,delta) units"
  bind $w.bot.entry $config(mwheel,neg) \
      "$w.text yview scroll \
       -$config(mwheel,delta) units"
  bind $w.bot.entry \
      $config(mwheel,pos) \
      "$w.text yview scroll \
       $config(mwheel,delta) units"
  balloonhelp_for $w.bot.entry \
      [_ "Command entry window. Bindings:\n<Return>\
       execute the entered command\n<Tab>\
       \tAttempt command completion each\n\
       \t<Tab> cycles to next possible completion\n<Cntl d>\
       \tShow possible command completions\n<Cntl c>\
       \tIf empty entry line abort the\n\
       \tlast command else clear the entry line\n<Up>\
       \tMove back in shell history\n<Down>\
       \tMove forward in shell history\n<Cntl p>\
       \tSearch back in command stack for\n\
       \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 $glob($inst,fid)"
      catch {chan close $fi}
      CompleteShell_pipe $inst $w $fi
    } else {
      Log "$glob($inst,fid) does not exist"
    }
  }
}

proc CompleteShow { inst w } {
  set cmd [$w.bot.entry get]
  #puts "completeshow $cmd"
  set insidx [expr [$w.bot.entry index insert] - 1]
  set wstart [string wordstart [FixCompleteString $cmd] $insidx]
  set wend [string wordend [FixCompleteString $cmd] $insidx]
  set word [string trim [string range $cmd $wstart $insidx]]
  #puts "word:$word"
  if {$word == ""} return
  if {$wstart == 0} { set is_verb 1 } else { set is_verb 0 }
  set l [FilenameComplete $word $is_verb $inst]
  $w.text insert end "\n$l"
  $w.text tag add complete "insert - 1 lines + 1 chars" "insert"
  $w.text see insert
}

proc FixCompleteString { cmd } {
  set l ""
  set len [string length $cmd]
  for {set i 0} {$i < $len} {incr i} {
    set c [string index $cmd $i]
    if {$c != " "} {
      set l "${l}x"
    } else {
      set l "${l}$c"
    }
  }
  return $l
}

proc Complete { inst w } {
  global glob
#  set glob($inst,shell,complete,flipping) 0

  if {!$glob($inst,shell,complete,flipping)} {
    set glob($inst,shell,complete,index) 0
    set cmd [$w.bot.entry get]
    set insidx [expr [$w.bot.entry index insert] - 1]
    set wstart [string wordstart [FixCompleteString $cmd] $insidx]
    set wend [string wordend [FixCompleteString $cmd] $insidx]
    set word [string trim [string range $cmd $wstart $insidx]]
    #puts "word:$word"
    if {$word == ""} return
    if {$wstart == 0} { set is_verb 1 } else { set is_verb 0 }
    set glob($inst,shell,complete,list) [FilenameComplete $word $is_verb $inst]
    set repl [lindex $glob($inst,shell,complete,list) \
		  $glob($inst,shell,complete,index)]
    incr glob($inst,shell,complete,index)
    if {$repl == ""} return
    #puts "repl:$repl"
    set head [string range $cmd 0 [expr $wstart-1]]
    set tail [string range $cmd $wend end]
    set newcmd "$head$repl$tail"
    $w.bot.entry delete 0 end
    $w.bot.entry insert end $newcmd
#    $w.bot.entry icursor [expr $insidx + 1]
    $w.bot.entry icursor [string wordend [FixCompleteString $newcmd] $insidx]
    #puts "$cmd,$word,$wstart,$insidx,$repl,$head,$tail"
    set glob($inst,shell,complete,flipping) 1
  } else {
    if {[$w.bot.entry get] != $glob($inst,shell,complete,newcmd) && \
	    $glob($inst,shell,complete,newidx) != [$w.bot.entry index insert]} {
      set glob($inst,shell,complete,flipping) 0
      Complete $inst $w
      return
    }
    set cmd $glob($inst,shell,complete,cmd)
    $w.bot.entry delete 0 end
    $w.bot.entry insert end $cmd
    set word $glob($inst,shell,complete,word) 
    set wstart $glob($inst,shell,complete,wstart)
    set wend $glob($inst,shell,complete,wend)
    set insidx $glob($inst,shell,complete,insidx)
    set repl [lindex $glob($inst,shell,complete,list) \
		  $glob($inst,shell,complete,index)]
    incr glob($inst,shell,complete,index)
    if {$repl == ""} { 
      $w.bot.entry icursor [string wordend [FixCompleteString $cmd] $insidx]
      set glob($inst,shell,complete,flipping) 0
      return
    }
    #puts "repl:$repl"
    set head [string range $cmd 0 [expr $wstart-1]]
    set tail [string range $cmd $wend end]
    set newcmd "$head$repl$tail"
    $w.bot.entry delete 0 end
    $w.bot.entry insert end $newcmd
#    $w.bot.entry icursor [expr $insidx + 1]
    $w.bot.entry icursor [string wordend [FixCompleteString $newcmd] $insidx]
    #puts "$cmd,$word,$wstart,$insidx,$repl,$head,$tail"
  }
  set glob($inst,shell,complete,cmd) $cmd
  set glob($inst,shell,complete,word) $word
  set glob($inst,shell,complete,wstart) $wstart
  set glob($inst,shell,complete,wend) $wend
  set glob($inst,shell,complete,insidx) $insidx
  set glob($inst,shell,complete,newidx) [$w.bot.entry index insert]
  set glob($inst,shell,complete,newcmd) $newcmd
}

proc FilenameComplete { word is_verb inst } {
  global glob config env
  set candidates {}
  if {$is_verb && [string index $word 0] != "/"} {
    foreach k [split $env(PATH) :] {
      set c [glob -nocomplain $k/${word}*]
      if {$c != ""} {
        set candidates [concat $candidates $c]
      }
    }
  } else {
    set r [catch {cd $glob($inst,pwd)} out]
    if {$r} {
      PopError "$out"
      return ""
    }
    set r [catch {glob -nocomplain ${word}*} c]
    if {!$r && $c != ""} {
      set candidates [concat $candidates $c]
    }
  }
  return $candidates
}



proc ExecCmdInWin { inst w } {
  global glob config env
  #  focus $w.bot.entry
  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
  set verb [lindex $cmd 0]
  if {[IsFTP $glob($inst,pwd)]} {
    PopError "Sorry, can't execute commands in ftp directories"
    return
  }

  set r [catch {cd $glob($inst,pwd)} out]
  if {$r} {
    PopError "$out"
    return
  }

  # expand aliases
  set alias ""
  foreach k $config(shell,aliases) {
    if {$verb == [lindex $k 0]} {
      set alias [lindex $k 1]
      break
    }
  }
  if {$alias != ""} {
    set cmd [concat $alias [lrange $cmd 1 end]]
    set verb [lindex $cmd 0]
  }
  # echo command to the window
  $w.text insert end "\n$glob($inst,pwd) > $cmd\n"
  $w.text tag add command "insert - 1 lines" "insert - 1 chars"
  $w.text see "insert - 1 chars"
  update
  # put it in the history
  lappend glob($inst,shell,history) $cmd
  set len [llength $glob($inst,shell,history)]
  if {$len > 250} {
    set glob($inst,shell,history) [lrange [expr $len - 200] end]
  }
  # check for special commands...
  #  a background command?
  if {[string match *& $cmd]} {
    catch {eval exec $cmd} out
    ToShellBuffer $w $out
    set prefix "Background shell: "
  } else {
    set prefix " "
    Log "switch on \"$verb\""
    switch -glob $verb { 
      %* {
	# Tcl commands
	set prefix "Tcl: "
        set r [catch { eval [string range $cmd 1 end] } out]
        if {$r} {
	  ToShellBuffer $w "tcl error: $out"
        } 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 {$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: $out"
        }
      }
      view {
	Log $cmd
        ViewAny [lrange $cmd 1 end]
      }
      history {
	Log "history"
        ToShellBuffer $w "$glob($inst,shell,history)"
      }
      default {
	Log "\"$cmd\" default"
	set prefix "Shell: "
	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
	}
	set r [catch {open "|$config(cmd,sh)  \{$cmd 2>&1\}" r} fid]
	if {$r} {
	  ToShellBuffer $w "Exec error: $fid\n"
	} else {
	  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 "CompleteShell_pipe called"
  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 $r $fid"
    if { $r } {
      Log " aborted"
    } else {
      Log " - done"
    }
  }
}



proc ToShellBuffer { w  chars } {
  global config
  $w.text insert end $chars
  $w.text see insert
  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 {
        if {!$glob($inst,shell,history,flipping)} {
          set start [expr [llength $glob($inst,shell,history)] - 1]
          set cmd [string trim [$w get]]
          set glob($inst,shell,history,flipping,cmd) $cmd
        } else {
          set start [expr $glob($inst,shell,history,flipping,index) -1]
          if {$start < -1} {set start -1}
          set cmd $glob($inst,shell,history,flipping,cmd)
        }
#        puts "$cmd $start"
        for {set i $start} {$i >= 0} {incr i -1} {
          if {$cmd == [string range \
			   [lindex $glob($inst,shell,history) $i] \
			   0 \
			   [expr [string length $cmd] -1]]} {
            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 "$reason (non fatal)"
  }
}

# This routine is for commands that don't want the autoupdater to run
# and invoke "update" during operation
proc DoProtCmd { cmd } {
  global glob 
  focus $glob(win,top).status
  frgrab $glob(win,top).menu_frame.fasync_cmds
  set oldcur [. cget -cursor]
  set oldena $glob(enableautoupdate)
  . config -cursor circle
  #wm iconname . "FileRunner v$glob(version) - busy"
  update idletasks
  if {$oldena != 0} {
    # we do this to avoid extra trace calls (see list updater)
    set glob(enableautoupdate) 0
  }
  set glob(abortcmd) 0
  uplevel $cmd
  if {$oldena != $glob(enableautoupdate) } {
    set glob(enableautoupdate) $oldena
  }
  . config -cursor $oldcur
  #wm iconname . "FileRunner v$glob(version)"
  catch {grab release [grab current]}
  #catch {focus $glob(focus_before_doprotcmd)}
  unset -nocomplain glob(whichdir)
  focus $glob(win,top).status 
}

# This routine is for commands that don't want the autoupdater to run
# but do not invoke "update" during operation
proc DoProtCmd_NoGrab { cmd } {
  global glob 
  #grab set $glob(win,top).menu_frame.fasync_cmds
  #focus $glob(win,top).status
  set oldcur [. cget -cursor]
  set oldena $glob(enableautoupdate)
  . config -cursor circle
  #wm iconname . "FileRunner v$glob(version) - busy"
  update idletasks
  if { $oldena != 0 } {
    set glob(enableautoupdate) 0
  }
  set glob(abortcmd) 0
  uplevel $cmd
  if {$oldena != $glob(enableautoupdate) } {
    set glob(enableautoupdate) $oldena
  }
  . config -cursor $oldcur
  #wm iconname . "FileRunner v$glob(version)"
  #grab release $glob(win,top).menu_frame.fasync_cmds
}

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

proc SetWinPos {} {
  global glob config
  set config(geometry,main) [wm geometry .]
  LogStatusOnly \
      "config(geometry,main) set. Do\
       \"Configuration->Save configuration\" if\
       you want to store it to the .fr file"
}


proc ShowCmds { dir } {
  global glob
  set height1 [winfo height $glob(win,middle)]
  set height2 [winfo height $glob(win,middle).1]
  set step [expr (3 * $height1) / (4 * $height2)]
  if { $step < 1 } { set step 1 }
  set oldcur $glob(cmds,cur)
  if { $dir == "down" } {
    incr glob(cmds,cur) $step
  }
  if { $dir == "up" } {
    incr glob(cmds,cur) -$step
  }

  set tmp [expr [llength $glob(cmds,list)] - ($height1-$height2)/$height2 ]
  if { $glob(cmds,cur) > $tmp } {
    set glob(cmds,cur) $tmp
  }

  set tmp [expr [llength $glob(cmds,list)] -1 ]
  if { $glob(cmds,cur) > $tmp } {
    set glob(cmds,cur) $tmp
  }
  if { $glob(cmds,cur) < 0 } {
    set glob(cmds,cur) 0
  }

  if {$oldcur < $glob(cmds,cur)} {
    for {set i $oldcur} {$i < $glob(cmds,cur)} {incr i} {
      pack forget $glob(win,middle).$i
    }
    return
  }
  if {$oldcur > $glob(cmds,cur)} {
    for {set i [expr $oldcur-1]} {$i >= $glob(cmds,cur)} {incr i -1} {
      pack $glob(win,middle).$i -before $glob(win,middle).[expr $i+1] -fill x
    }
    return
  }
}

proc About {} {
  global glob
  set button [tk_dialog_about .apop "About FileRunner" \
		  "FileRunner version $glob(version)

 Copyright (C) 2010 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.
" "" 0 "OK"]
}

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

proc BuildFileListPanel { inst } {

  global glob config

  frame $glob(win,$inst) -borderwidth 1 -relief raised
  frame $glob(win,$inst).dirmenu_frame -borderwidth 1 -relief raised
  frame $glob(win,$inst).top -bd 1 -relief raised
  frame $glob(win,$inst).top.t -bd 0 -relief raised
  frame $glob(win,$inst).frame_listb

  # The tree button
  menubutton $glob(win,$inst).dirmenu_frame.dir_but -menu \
      $glob(win,$inst).dirmenu_frame.dir_but.m \
      -bitmap @$glob(lib_fr)/bitmaps/tree.bit
  balloonhelp_for $glob(win,$inst).dirmenu_frame.dir_but \
      [_ "Directory tree scan." ]

  menu $glob(win,$inst).dirmenu_frame.dir_but.m \
      -tearoff false -postcommand  "eval CdMenuCreate \
      ${inst} \[Esc \$glob($inst,pwd) \] \
      $glob(win,$inst).dirmenu_frame.dir_but.m 1"

  # Hotlist button
  menubutton $glob(win,$inst).dirmenu_frame.hotlist_but -menu \
      $glob(win,$inst).dirmenu_frame.hotlist_but.m -text Hotlist

  menu $glob(win,$inst).dirmenu_frame.hotlist_but.m \
      -tearoff false -postcommand "CreateHotListMenu $inst"
  # History button  
  menubutton $glob(win,$inst).dirmenu_frame.history_but -menu \
      $glob(win,$inst).dirmenu_frame.history_but.m -text History

  menu $glob(win,$inst).dirmenu_frame.history_but.m \
      -tearoff false -postcommand "CreateHistoryMenu $inst"

  # Etc button
  menubutton $glob(win,$inst).dirmenu_frame.etc_but -menu \
      $glob(win,$inst).dirmenu_frame.etc_but.m -text Etc
  # Build the Etc menu
  menu $glob(win,$inst).dirmenu_frame.etc_but.m -tearoff false 
  $glob(win,$inst).dirmenu_frame.etc_but.m add command \
      -label {Find File...} -command "DoProtCmd \"CmdFind $inst\""
  $glob(win,$inst).dirmenu_frame.etc_but.m add command \
      -label {Create Empty File...} -command \
      "DoProtCmd \"CmdCreateEmptyFile $inst\""
  $glob(win,$inst).dirmenu_frame.etc_but.m add command \
      -label {Recurse Command...} -command \
      "DoProtCmd \"CmdRecurseCommand $inst\""
  $glob(win,$inst).dirmenu_frame.etc_but.m add command \
      -label {Add To FTP Batch List} -command \
      "AddToBatchList $inst"
  $glob(win,$inst).dirmenu_frame.etc_but.m add command \
      -label {View FTP Batch List} -command \
      "ViewBatchList"
  $glob(win,$inst).dirmenu_frame.etc_but.m add command \
      -label {Clear FTP Batch List} -command \
      "set glob(batchlist) {}"
  $glob(win,$inst).dirmenu_frame.etc_but.m add command \
      -label {FTP Batch Receive} -command  \
      "DoProtCmd \"BatchReceiveFTP $inst\""
  $glob(win,$inst).dirmenu_frame.etc_but.m add command \
      -label {HTTP Download} -command \
      "DoProtCmd \"CmdGetHttp $inst\""


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

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

  # The command at the bottom button
  button $glob(win,$inst).top.button_frterm \
      -borderwidth 1 -bitmap @$glob(lib_fr)/bitmaps/frterm.bit \
      -command "ToggleCmdWin $inst"
  balloonhelp_for $glob(win,$inst).top.button_frterm \
      [_ "Open/Close a command sub\n window\
         at the bottom of this one." ]

  # The update button
  button $glob(win,$inst).top.button_update \
      -borderwidth 1 -bitmap @$glob(lib_fr)/bitmaps/update.bit \
      -command \
      "DoProtCmd \"set glob(forceupdate) 1; FTP_InvalidateCache; \
       UpdateWindow $inst; set glob(forceupdate) 0\""
  balloonhelp_for $glob(win,$inst).top.button_update \
      [_ "Update the dir list." ]

  # The dir line window
  entry $glob(win,$inst).entry_dir \
      -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 \
      [_ "Dir line.\nFollows dir changes.\nEnter\
          a new dir here if desired.\nAlso\
          used as input by MkDir and Select buttons." ]

  # Create listbox
  frame $glob(win,$inst).frame_listb.right -bd 0
  scrollbar $glob(win,$inst).frame_listb.scroll_horiz \
      -command "ListBoxHScroll $glob(win,$inst).frame_listb" \
      -orient {horizontal} \
      -relief {sunken}
  scrollbar $glob(win,$inst).frame_listb.right.scroll_vert \
      -command "$glob(win,$inst).frame_listb.listbox1 yview" \
      -relief {sunken}
#      -xscrollcommand "$glob(win $inst).frame_listb.scroll_horiz set" \
#      -yscrollcommand "$glob(win,$inst).frame_listb.right.scroll_vert set" \
#      -selectmode extended \

  text $glob(win,$inst).frame_listb.listbox0 \
      -height 1\
      -width 1\
      -wrap none \
      -relief {ridge} \
      -xscrollcommand "ListBoxXScroll $glob(win,$inst).frame_listb"\
      -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)
  listbox $glob(win,$inst).frame_listb.listbox1 \
      -relief {ridge} \
      -xscrollcommand "ListBoxXScroll $glob(win,$inst).frame_listb"\
      -yscrollcommand "$glob(win,$inst).frame_listb.right.scroll_vert set" \
      -selectmode extended \
      -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)
  lappend glob(gui,color_xx,winlist) \
      $glob(win,$inst).frame_listb.listbox0 \
      $glob(win,$inst).frame_listb.listbox1
  lappend glob(gui,tablist) $glob(win,$inst).frame_listb.listbox1
  balloonhelp_for $glob(win,$inst).frame_listb.listbox0 \
      [_ "List box entry labels." ]
  balloonhelp_for $glob(win,$inst).frame_listb.listbox1 \
      [_ "Dir list box. Button bindings:\n<Tab>\
       \t\tMove focus to other window\n<Left Mouse>\
       \tSelect file under mouse\n<Right Mouse>\
       \tIf dir, open that dir in this window\n\
       \t\telse run rule selected program on selected file(s)\n\
       \t\tNote rule is base on the first selected file.\n<Dbl Left Mouse>\
       \tExecute user selected Editor on selected file(s)\n<Shift Left Mouse>\
       Extend selection from last single selected entry\n<Cntl Left Mouse>\
       \tAdd the file under the mouse to the selection" ]
  # Bind the buttons
  bind $glob(win,$inst).frame_listb.listbox1 \
      <Tab> {TabBind $glob(gui,tablist);break}
  bind $glob(win,$inst).frame_listb.listbox1 \
      $config(mwheel,neg) \
      "$glob(win,$inst).frame_listb.listbox1 yview scroll \
       -$config(mwheel,delta) units"
  bind $glob(win,$inst).frame_listb.listbox1 \
      $config(mwheel,pos) \
      "$glob(win,$inst).frame_listb.listbox1 yview scroll \
       $config(mwheel,delta) units"

  selection handle $glob(win,$inst).frame_listb.listbox1 \
      GetFileListBoxSTRING_Selection STRING

  label $glob(win,$inst).top.t.stat -text "" -justify center

  button $glob(win,$inst).frame_listb.right.select_toggle \
      -bitmap @$glob(lib_fr)/bitmaps/toggle.bit \
      -command "ToggleSelect $inst" \
      -width 1 -height 12 -bd 1
  balloonhelp_for $glob(win,$inst).frame_listb.right.select_toggle \
      [_ "Toggle the selection(s)." ]
  pack $glob(win,$inst).dirmenu_frame.dir_but \
    $glob(win,$inst).dirmenu_frame.hotlist_but \
    $glob(win,$inst).dirmenu_frame.history_but \
    $glob(win,$inst).dirmenu_frame.etc_but -side left -fill both
  pack $glob(win,$inst).dirmenu_frame.button_parentdir \
      -side left -expand 1 -fill both

  pack $glob(win,$inst).frame_listb.right -side right -fill y
  pack $glob(win,$inst).frame_listb.right.scroll_vert \
      -side top -fill y -expand 1
  pack $glob(win,$inst).frame_listb.right.select_toggle -side bottom -fill both
  pack $glob(win,$inst).frame_listb.listbox0 -side top -expand 0 -fill x
  pack $glob(win,$inst).frame_listb.listbox1 -side top -expand 1 -fill both
  pack $glob(win,$inst).frame_listb.scroll_horiz -side bottom -fill x

  pack $glob(win,$inst).top -side top -fill x
  pack $glob(win,$inst).top.button_xterm -side right -fill both
  pack $glob(win,$inst).top.button_frterm -side right -fill both
  pack $glob(win,$inst).top.button_back -side left -fill both
  pack $glob(win,$inst).top.button_update -side left -fill both
  pack $glob(win,$inst).top.t -side left -fill both -expand 1
  pack propagate $glob(win,$inst).top.t 0
  pack $glob(win,$inst).top.t.stat -side left -fill both -expand 1
  pack $glob(win,$inst).dirmenu_frame -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
}
# procedures to keep the listbox and head in sync.
proc ListBoxXScroll { w a b } {
  $w.scroll_horiz set $a $b
  ListBoxHScroll $w moveto $a
}

proc ListBoxHScroll { w a {b ""} {c ""} } {
  if {$c == ""} {
    $w.listbox1 xview $a $b
    $w.listbox0 xview $a $b
  } else {
    $w.listbox1 xview $a $b $c
    $w.listbox0 xview $a $b $c
  }
}
# 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 {}
  foreach inst {left right} {
    foreach sel [$glob(win,$inst).frame_listb.listbox1 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
}

proc GetDirList { inst } {
  global config glob
  global ftp
  set directory $glob($inst,pwd)
  set dl {}
  set type ""

  if { [IsFTP $directory] } {
    set mode ftp
    regexp {ftp://([^/]*)(.*)} $directory match ftpI directory
  } else {
    set mode normal
  }

  if { $mode == "ftp" } {
    # cancel notify if to this pane
    if {$glob(notify,$inst) != "" } {
      if {$glob(notify,left) != $glob(notify,right) } {
	catch {$global(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}}
    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

    #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 dosorttest 1

    switch -exact $config(fileshow,sort) {
      nameonly {
	set sortval_n  1
	set sortval_d  1
	set sortval_l  1
	set sortval_ld 1
	set dosorttest 0
      } 
      dirsfirst {
	set sortval_n  2
	set sortval_d  1
	set sortval_l  2
	set sortval_ld 1
	set dosorttest 0
      }
      dirslast {
	set sortval_n  1
	set sortval_d  2
	set sortval_l  1
	set sortval_ld 2
	set dosorttest 0
      }
    }


    foreach k $dirlist {
      if { $k == "" } continue
      if { [string range $k 0 4] == "total" } continue

      set filetype fn

      # Try regular parsing
      if {$ftp($ftpI,debug) } {
#	puts "$k"
#	puts "try regular dir"
      }
      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} {
	# Try wuarchive.wustl.edu parsing
	if { $mode == "ftp" && $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) } {
	    puts "try WinNT dir"
	  }
	  
	  set \
	      r \
	      [regexp \
		   {(.................)(......................)(.+)} \
		   $k match date type i1]
	  if {!$r} {
	    PopError "Error parsing ftp LIST output: $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]
	  if { $r != 0 } { PopError "Fatal error: $outp"; CleanUp 1 }
	  if {!$outp} {
	    set filetype fl
	  } else {
	    set filetype fld
	  }
	} else {
	  set filetype fld
	}
	}
	s  -
	p  -
	n  { set filetype fn }
	default { PopError "Error parsing ftp LIST output: $k"; \
		      return $dummy }
      }
      set sec [FTPDateStringToSeconds $date]
      if {$dosorttest} {
	switch -exact $config(fileshow,sort) {
	  time {
	    set tmp [format "%011d" $sec]
	    set sortval_n  $tmp
	    set sortval_d  $tmp
	    set sortval_l  $tmp
	    set sortval_ld $tmp
	  }
	  rtime {
	    set tmp [format "%011d" [expr 2147483647 - $sec]]
	    set sortval_n  $tmp
	    set sortval_d  $tmp
	    set sortval_l  $tmp
	    set sortval_ld $tmp
	  }
	  size {
	    set tmp [format "%011d" $size]
	    set sortval_n  $tmp
	    set sortval_d  $tmp
	    set sortval_l  $tmp
	    set sortval_ld $tmp
	  }
	  extension {
	    set tmp [file extension $file]$file
	    set sortval_n  $tmp
	    set sortval_d  $tmp
	    set sortval_l  $tmp
	    set sortval_ld $tmp
	  }
	}
      }
      
      switch -exact $filetype {
	fn  {lappend dl [list $sortval_n  $file fn  $size $sec\
			     $flags $owner $group $nlinks]}

	fd  {lappend dl [list $sortval_d  $file fd  $size $sec\
			     $flags $owner $group $nlinks]}

	fl  {lappend dl [list $sortval_l  $file fl  $size $sec \
			     $flags $owner $group $link $nlinks]}

	fld {lappend dl [list $sortval_ld $file fld $size $sec \
			     $flags $owner $group $link $nlinks]}
      }
    }
    if { $mode == "ftp" && $ftp($ftpI,debug) } {
      puts "$dl"
    }
    return [lsort $dl]
  }
  #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).
  cd $directory/
  set dl {}
  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) } {
    set r [catch {glob -nocomplain -type hidden *} dirlist2]
    if {$r} {
      return -code 1 $dirlist2
    }
    set dirlist [concat $dirlist2 $dirlist]
  }
  #puts ">$dirlist<"
  set dosorttest 1

  switch -exact $config(fileshow,sort) {
    nameonly {
      set sortval_n  1
      set sortval_d  1
      set sortval_l  1
      set sortval_ld 1
      set dosorttest 0
    } 
    dirsfirst {
      set sortval_n  2
      set sortval_d  1
      set sortval_l  2
      set sortval_ld 1
      set dosorttest 0
    }
    dirslast {
      set sortval_n  1
      set sortval_d  2
      set sortval_l  1
      set sortval_ld 2
      set dosorttest 0
    }
  }

  foreach k $dirlist {
    if {[catch { file lstat "$k" statinfo }]} continue

    set filetype n

    if {($statinfo(mode) & 0170000) == 040000} {
      set filetype d
    }

    if {($statinfo(mode) & 0170000) == 0120000} {
      set filetype l
      catch {file readlink "$k"} linkname
      if {[file isdirectory "$k"]} {
	     set filetype ld
      }
    }

    if {$dosorttest} {
      switch -exact $config(fileshow,sort) {
	     time {
	       set tmp [format "%011d" $statinfo(mtime)]
	       set sortval_n  $tmp
	       set sortval_d  $tmp
	       set sortval_l  $tmp
	       set sortval_ld $tmp
	     }
	     rtime {
	       set tmp [format "%011d" [expr 2147483647 - $statinfo(mtime)]]
	       set sortval_n  $tmp
	       set sortval_d  $tmp
	       set sortval_l  $tmp
	       set sortval_ld $tmp
	     }
        size {
	       set tmp [format "%011d" $statinfo(size)]
	       set sortval_n  $tmp
	       set sortval_d  $tmp
	       set sortval_l  $tmp
	       set sortval_ld $tmp
        }
	     extension {
	       set tmp [file extension $k]$k
	       set sortval_n  $tmp
	       set sortval_d  $tmp
	       set sortval_l  $tmp
	       set sortval_ld $tmp
	     }
      }
    }
    switch -exact $filetype {
      n  {lappend dl [list $sortval_n $k n $statinfo(size) \
			  $statinfo(mtime) $statinfo(mode) \
			  $statinfo(uid) $statinfo(gid) \
			  $statinfo(nlink)]}

      d  {lappend dl [list $sortval_d $k d $statinfo(size) \
			  $statinfo(mtime) $statinfo(mode) \
			  $statinfo(uid) $statinfo(gid) \
			  $statinfo(nlink)]}

      l  {lappend dl [list $sortval_l $k l $statinfo(size) \
			  $statinfo(mtime) $statinfo(mode) \
			  $statinfo(uid) $statinfo(gid) \
			  $linkname $statinfo(nlink)]}

      ld {lappend dl [list $sortval_ld $k ld $statinfo(size) \
			  $statinfo(mtime) $statinfo(mode) \
			  $statinfo(uid) $statinfo(gid) \
			  $linkname $statinfo(nlink)]}
     }
  }

  
  # This will not correctly sort filenames with more than one word, 
  # but who cares...
  return [lsort -command "testit" $dl]

}
# This fixes the 'space in the file name' problem.
proc testit { s1 s2} {
  regsub -all {\{} $s1 {} s3
  regsub -all {\{} $s2 {} s4
#  Log "s3=$s3 s4=$s4"
  return [string compare $s3 $s4]
}

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
proc ConstructFileList { inst } {
  global glob
  set dirlist $glob($inst,filelist)
  set dir $glob($inst,pwd)
  set fl {}
  set maxln 0
# To Do: Allow configure to remove the link count.
  set linkfmt "%-26s %2d %7.0f %s %s %s -> %s "
  set normfmt "%-26s %2d %7.0f %s %s %s "
  set glob($inst,listhead) [format "%-26s %2s %7s %15s %9s %-13s %-26s" \
				"File/Dir name" \
				"lk" \
				"size" \
				"mtime    " \
				"flags  " \
				"owner" \
				"link to" ]
  foreach k $dirlist {
    set type [lindex $k 2]
    set file [lindex $k 1]
#    puts "Construct File List $k"
    switch $type {
      l   {
        set nfl [format $linkfmt \
		     "$file@" \
		     "[lindex $k 9]" \
		     "[lindex $k 3]" \
		     "[GetTimeFromSecs [lindex $k 4]]" \
		     "[GetStringFromMode [lindex $k 5]]" \
		     "[GetUidGidString $dir/$file \
                         [lindex $k 6] [lindex $k 7]]" \
		     "[lindex $k 8]" ]
      }
      ld  {
        set nfl [format $linkfmt  \
		     "$file@/" \
		     "[lindex $k 9]" \
		     "[lindex $k 3]" \
		     "[GetTimeFromSecs [lindex $k 4]]" \
		     "[GetStringFromMode [lindex $k 5]]" \
		     "[GetUidGidString $dir/$file \
                         [lindex $k 6] [lindex $k 7]]" \
		     "[lindex $k 8]" ]
      }
      d   {
        set nfl [format $normfmt \
		     "$file/" \
		     "[lindex $k 8]" \
		     "[lindex $k 3]" \
		     "[GetTimeFromSecs [lindex $k 4]]" \
		     "[GetStringFromMode [lindex $k 5]]" \
		     "[GetUidGidString $dir/$file \
                         [lindex $k 6] [lindex $k 7]]"  ]
      }
      n   {
        set nfl [format $normfmt \
		     "$file" \
		     "[lindex $k 8]" \
		     "[lindex $k 3]" \
		     "[GetTimeFromSecs [lindex $k 4]]" \
		     "[GetStringFromMode [lindex $k 5]]" \
		     "[GetUidGidString $dir/$file \
                         [lindex $k 6] [lindex $k 7]]"  ]
      }
      fl  {
	# FTP file types start with "f" 
        set nfl [format $linkfmt \
		     "$file@" \
		     "[lindex $k 9]" \
		     "[lindex $k 3]" \
		     "[GetTimeFromSecs [lindex $k 4]]" \
		     "[lindex $k 5]" \
		     "[lindex $k 6]/[lindex $k 7]" \
		     "[lindex $k 8]" ]
      }
      fld {
        set nfl [format $linkfmt \
		     "$file@/" \
		     "[lindex $k 9]" \
		     "[lindex $k 3]" \
		     "[GetTimeFromSecs [lindex $k 4]]" \
		     "[lindex $k 5]" \
		     "[lindex $k 6]/[lindex $k 7]" \
		     "[lindex $k 8]" ]
      }
      fd  {
        set nfl [format $normfmt \
		     "$file/" \
		     "[lindex $k 8]" \
		     "[lindex $k 3]" \
		     "[GetTimeFromSecs [lindex $k 4]]" \
		     "[lindex $k 5]" \
		     "[lindex $k 6]/[lindex $k 7]"  ]
      }
      fn  {
        set nfl [format $normfmt \
		     "$file" \
		     "[lindex $k 8]" \
		     "[lindex $k 3]" \
		     "[GetTimeFromSecs [lindex $k 4]]" \
		     "[lindex $k 5]" \
		     "[lindex $k 6]/[lindex $k 7]"  ]
      }
    }
    lappend fl $nfl
    if {[string length $nfl] > $maxln } {
      set maxln [string length $nfl]
    }
  }
  if { [set pad [expr $maxln - 105]] < 0 } {
    set pad 0
  }
  incr maxln -1
  set glob($inst,listhead) [string range \
      [format "%-26s %2s %7s %15s %9s %-13s %-26s %-${pad}s" \
	   "File/Dir name" \
	   "lk" \
	   "size" \
	   "mtime    " \
	   "flags  " \
	   "owner" \
	   "link to" \
	   " "] 0 $maxln]
# that string is 104 chars long...
  
  return $fl
}

proc InitWindows {} {
  global glob
    set glob(select_pry_lr) nil
    set glob(select_pry_s) ""
    set glob(select_cur_lr) nil
    set glob(select_cur_s) ""
  UpdateWindow both
}

proc Back { inst } {
  global glob
  while { 1 } {
    set dir [lindex [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
  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

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

  # 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)
      return ""
    }
  }

  # next line for autoupdater 
  # (quick => left==right this is right and just did left or visa versa)
  if {$quick} {
    set glob($inst,lastmtime) $glob([Opposite $inst],lastmtime)
    set oldy [lindex [$glob(win,[Opposite $inst]).frame_listb.listbox1 yview] 0]
  } else {
    catch {set glob($inst,lastmtime) [file mtime $glob($inst,pwd)]}
    set oldy [lindex [$glob(win,$inst).frame_listb.listbox1 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([Opposite $inst],filelist)
  } else {
    set r [catch {GetDirList $inst} glob(${inst},filelist)]
  }
  if {$r != 0} {
    PopError "Updating $inst panel:\
              Error reading directory $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
    }
  }

  # update the dir box
#  $glob(win,$inst).frame_listb.listbox0 delete 0.0 end
#  $glob(win,$inst).frame_listb.listbox0 insert 0.10 $glob($inst,listhead)
  $glob(win,$inst).entry_dir delete 0 end
  $glob(win,$inst).entry_dir insert end $glob(${inst},pwd)

  # 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
  $glob(win,$inst).frame_listb.listbox0 delete 0.0 end
  $glob(win,$inst).frame_listb.listbox1 delete 0 end
  if {$quick} {
    eval $glob(win,$inst).frame_listb.listbox1 insert end \
	[$glob(win,[Opposite ${inst}]).frame_listb.listbox1 get 0 end]
    $glob(win,$inst).frame_listb.listbox0 insert 0.10 \
	$glob([Opposite ${inst}],listhead)
  } else {
    eval $glob(win,$inst).frame_listb.listbox1 insert end \
	[ConstructFileList $inst ]
    $glob(win,$inst).frame_listb.listbox0 insert 0.10 $glob($inst,listhead)
  }
  # Here is where we position the text in the window....
  if {$glob(${inst},update_oldpwd) == $glob(${inst},pwd)} {
    $glob(win,$inst).frame_listb.listbox1 yview moveto $oldy
  } else {
    if {[lindex [lindex $glob($inst,dirstack) 1] 0] == $glob(${inst},pwd) } {
      $glob(win,$inst).frame_listb.listbox1 yview moveto \
	  [lindex [lindex $glob($inst,dirstack) 1] 1]
    } 
  }
  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
#    }
  }
  return $newdir
}

proc ToggleSelectEntry { inst y } {
  global glob
  set index [$glob(win,$inst).frame_listb.listbox1 nearest $y]
  if {[$glob(win,$inst).frame_listb.listbox1 selection includes $index]} {
    $glob(win,$inst).frame_listb.listbox1 selection clear $index
    set glob(listbox,last) clear
    set glob(listbox,last,idx) $index
  } else {
    $glob(win,$inst).frame_listb.listbox1 selection set $index
    set glob(listbox,last) set
    set glob(listbox,last,idx) $index
  }
}

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(win,$inst).frame_listb.listbox1 nearest $y]
    $glob(win,$inst).frame_listb.listbox1 selection \
	$glob(listbox,last) $glob(listbox,last,idx) $index 
  }
}

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).frame_listb.listbox1 <2> "
      ToggleSelectEntry ${inst} %y
      break
    "
    bind $glob(win,$inst).frame_listb.listbox1 <B2-Motion> "
      ToggleSelectEntryMotion ${inst} %y
      break
    "
    bind $glob(win,$inst).frame_listb.listbox1 <3> "
      DoBut3 ${inst} \[lindex \$glob(${inst},filelist)\
       \[$glob(win,$inst).frame_listb.listbox1 nearest %y\]\]
    "
    bind $glob(win,$inst).frame_listb.listbox1 <Double-1> "
      DoBut1d ${inst} \[lindex \$glob(${inst},filelist)\
       \[$glob(win,$inst).frame_listb.listbox1 nearest %y\]\]
    "
    bind $glob(win,$inst).frame_listb.listbox1 <Control-3> "
      DoBut3Ctrl ${inst} \[lindex \$glob(${inst},filelist)\
       \[$glob(win,$inst).frame_listb.listbox1 nearest %y\]\]
    "
    bind $glob(win,$inst).frame_listb.listbox1 <Control-Double-1> "
      DoBut3Ctrl ${inst} \[lindex \$glob(${inst},filelist)\
       \[$glob(win,$inst).frame_listb.listbox1 nearest %y\]\]
    "
    bind $glob(win,$inst).frame_listb.listbox1 <ButtonRelease-1> "+UpdateStat"
    bind $glob(win,$inst).frame_listb.listbox1 <ButtonRelease-2> "+UpdateStat"
    if {$config(keyb_support)} {
      bind $glob(win,$inst).frame_listb.listbox1 <Any-1> \
	  "+focus $glob(win,$inst).frame_listb.listbox1"
      bind $glob(win,$inst).frame_listb.listbox1 <Escape> "focus ."
      bind $glob(win,$inst).frame_listb.listbox1 <Left> "DoProtCmd \" 
          NewPwd $inst \\\$glob(${inst},pwd)/..
          UpdateWindow $inst\"
          catch \"focus $glob(win,$inst).frame_listb.listbox1\"
          $glob(win,$inst).frame_listb.listbox1 activate 0
          break
        "
      bind $glob(win,$inst).frame_listb.listbox1 <Right> "
          DoProtCmd CmdView
          catch \"focus $glob(win,$inst).frame_listb.listbox1\"
          $glob(win,$inst).frame_listb.listbox1 activate 0
          break
        "
      bind $glob(win,$inst).frame_listb.listbox1 <KeyPress> \
	  "DoCommandOnKey $inst %A"
    }
  }
  if {!$config(keyb_support)} {
    bind . <KeyPress> "
      ShowListOnKey %A
    "
  }
}

proc DoCommandOnKey { inst key } {
  global glob
  if {$key == ""} return
  if {$key == "\r"} {
    DoProtCmd "CmdView"
    catch "focus $glob(win,$inst).frame_listb.listbox1"
    return
  }
  foreach k [lrange $glob(cmds,list) 1 end] {
    if {$key == [lindex $k 2]} {
      DoProtCmd "[lindex $k 1]"
      catch "focus $glob(win,$inst).frame_listb.listbox1"
      return
    }
  }

  LogStatusOnly "Cannot recognize keyboard shortcut $key"
}

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

proc UpdateStat_ { inst } {
  global glob
  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).

    set select [$glob(win,$inst).frame_listb.listbox1 curselection]
    if {[llength $select]} {
	if { $inst != $glob(select_cur_lr) || 
	     [join $select "*"] != $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) [join $select "*"]
	    LogStatusOnly "$glob(select_pry_lr) $glob(select_pry_s)"
	}
    }

  foreach k [$glob(win,$inst).frame_listb.listbox1 curselection] {
    set e [lindex $glob($inst,filelist) $k]
    incr s [lindex $e 3]
    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   $glob($inst,df)"
  return $n  
}


proc ToggleSelect { inst } {
  global glob
  if {[$glob(win,$inst).frame_listb.listbox1 curselection] != {}} { 
    $glob(win,$inst).frame_listb.listbox1 selection clear 0 end
  } else {
    $glob(win,$inst).frame_listb.listbox1 selection set 0 end
  }
  UpdateStat
}


proc ShowListOnKey { char } {
  global glob
  if {$char == ""} return
  set foc [focus]
  switch -glob $foc {
    *entry* return
  }
  ShowListOnKey_ $glob(win,left).frame_listb.listbox1 \
      glob(left,filelist) $glob(left,pwd) $glob(right,pwd) "$char"
  ShowListOnKey_ $glob(win,right).frame_listb.listbox1 \
      glob(right,filelist) $glob(right,pwd) $glob(left,pwd) "$char"
}

proc ShowListOnKey_ { listb_name filelist_var frompwd topwd char } {
  global glob
  upvar $filelist_var filelist
  set first ""
  set last ""
  if {[$listb_name curselection] != ""} {
    if {[string match \[A-Za-z0-9\] $char]} {
      set n 0
      foreach k $filelist {
        #puts "[string index [lindex $k 1] 0] == $char"
        if {[string index [lindex $k 1] 0] >= "$char" && [IsFile $k]} {
          if {$first == ""} {
            set first $n
          }
          set last $n
        } 
        incr n
      }
      
      if {$last != ""} {
        $listb_name see $last
      }
      if {$first != ""} {
        $listb_name see $first
      } elseif {$last == ""} {
	$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
  #puts "CdMenuCreateCasc curdir: \'$curdir\'"
  set n 0
  if {[winfo exists $menuwid.0]} {
    destroy $menuwid.0
  }
  menu $menuwid.0 -tearoff false

  if {$level == 1} {
    if {[winfo exists $menuwid.0.$n]} {
      destroy $menuwid.0.$n
    }
    menu $menuwid.0.$n -tearoff false -postcommand \
	"CdMenuCreate $inst / $menuwid.0.$n [expr $level+1]"
    $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 false -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
  #puts "CdMenuCommand dir \'$dir\'"
  destroy $glob(win,$inst).dirmenu_frame.dir_but.m
  menu $glob(win,$inst).dirmenu_frame.dir_but.m -tearoff false -postcommand \
      "eval CdMenuCreate $inst \[Esc \$glob($inst,pwd)\] \
      $glob(win,$inst).dirmenu_frame.dir_but.m 1"
  #update idletasks
  DoProtCmd "NewPwd $inst [Esc $dir] ; UpdateWindow $inst"
}


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

proc DoBut1d { inst fileelem } {
  DoProtCmd_NoGrab "CmdEdit"
}


proc DoBut3 { inst fileelem } {
  DoProtCmd_NoGrab "DoBut3_ $inst \$fileelem"
}

proc DoBut3_ { inst fileelem } {
  global glob env config
  switch [lindex $fileelem 2] {
    fd  -
    fld -
    ld  - 
    d   { NewPwd $inst $glob($inst,pwd)/[lindex $fileelem 1]
          UpdateWindow $inst
        }
    fn  -
    fl  {
          set r [regexp {ftp://([^/]*)(.*)} \
		     $glob($inst,pwd) match ftpI directory]
          if {$r == 0} { 
            PopError "Can't parse $glob($inst,pwd) as ftp URL" 
          } else { 
            set r 0
            if { ! [file exists $glob(tmpdir)] } {
              set r [Try { file mkdir $glob(tmpdir) } "" 1]
            }
            if { !$r } {
              set size [lindex $fileelem 3]
              if {[lindex $fileelem 2] == "fl"} {set size -1}
              set r [Try { FTP_GetFile $ftpI \
			       "$directory/[lindex $fileelem 1]" \
			       "$glob(tmpdir)/[lindex $fileelem 1]" \
			       $size 0 } "" 1]
              if {$r == 0} { 
		          regsub {\ } \
			      "$glob(tmpdir)/[lindex $fileelem 1]" {\\ } \
			      filen
		          ViewAny "$filen"
		          set glob(havedoneftp) 1 
	           }
            }
          }
        }
    n   -
    l   {
          ViewAny [list "$glob($inst,pwd)/[lindex $fileelem 1]"]
        }
  }
}

proc Opposite { inst } {
  if {$inst == "left" } {return right}
  if {$inst == "right" } {return left}
  error "Internal error ($inst)"
}

proc DoBut3Ctrl { inst fileelem } {
  DoProtCmd_NoGrab "DoBut3Ctrl_ $inst \{$fileelem\}"
}

proc DoBut3Ctrl_ { inst fileelem } {
  global glob
  switch [lindex $fileelem 2] {
    fd  -
    fld -
    ld  - 
    d   { NewPwd [Opposite $inst] $glob($inst,pwd)/[lindex $fileelem 1]
          UpdateWindow [Opposite $inst]
        }
  }
}

proc CheckAbort { info } {
  global glob
  update
  if { $glob(abortcmd) } {
    Log "$info aborted"
    #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(win,left).frame_listb.listbox1 \
	     glob(left,filelist) $glob(left,pwd) $glob(right,pwd) $proc]
  if {$r} {
    UpdateWindow both
    return
  }
  set r [DoUsrCmd_ $glob(win,right).frame_listb.listbox1 \
	     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 \
      [tk_dialog_fr .apop "!" \
	   "$file is not owned by you. OK to go ahead and try to $action anyway?" \
	   "" 1 \
	   "Yes" "No"]
  if {$r == 0} {return 1}
  return 0
}
proc FtpCheckSyntax { inst newpwd } {
  global glob config
  upvar newpwd newdir
  set newdir $newpwd
  while { 1 } {
    set r [regexp {ftp://([^/]*)(.*)} $newdir match ftpI newpwd2]
    if {$r != 0 && $ftpI != "" && $newpwd2 == ""} { set newpwd2 / }
    if {$r == 0 || $ftpI == "" || $newpwd2 == ""} { 
      set \
	  newdir \
	  [EntryDialog  $glob(win,$inst) \
	       "Error in path" \
	       "Malformed URL $newpwd\nFormat:\
                ftp://<site>/<path>\nPlease edit new path or cancel." \
	       $newpwd warning]
      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
    }
    set r [catch {OpenFTP $ftpI} out]
    if {$r} { 
      if {$out == "ABORT_FTP_LOGIN_PLEASE" } {
	LogStatusOnly "FTP login aborted"
	set newdir ""
	return -code continue ""
      }
      set newdir [EntryDialog  $glob(win,$inst)  \
		      "Error connecting" \
		      "Error: $out\n\nPlease edit new path or cancel." \
		      $newdir warning]
      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]
    if {$r} { 
      # NO! See if s/he can help us with the path...
      set newdir \
	  [EntryDialog  $glob(win,$inst)  \
	       "Error in path, can not cd to it" \
	       "Error: $out\nPlease edit new path or cancel.\
                If you want to create it, press Create." \
	       $newdir warning 1]

      # 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 == ""  || ! [IsFTP $newdir] } { 
	return -code continue
      }
      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) ftp://$ftpI$out
    } else {
      # not sure here.  we cd'd to the dir but failed the PWD???
      PopError "$out"
      set newdir "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://$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]
 
  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 {
      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 {[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 $glob(win,$inst)  \
			  "Error in path (not readable)"\
		     "Error: $out\nPlease edit new path or cancel.\
                      If you want to create it, press Create." \
		  $newpwd warning 1]
	     # If s/he returned cancel or abort or nil, if there 
	     # is an old path just return, else ... well insist...
        if {$newpwd == "" && $curdir != ""}  return ""
	     set ask 0
        continue
      }
      if {$config(cd_pwd)  &&
	  [regexp -nocase -lineanchor \
		  {^[a-z]:/.*$|^/.*$|^//[^/]+/[^/]+/.*$} $newpwd] == 1} {
	set r [catch {Pwd} out]
	if {$r} { 
	  PopError "Trying to get directory info: $out"
	  if { $curdir != "" } return ""
	  continue
	}
	set newpwd $out
      } else {
	# Evaluate xxx/yyy/zzz/../.. to xxx
	set newpwd [file normalize $newpwd]
      }
      regsub -nocase {(^[a-z]:)/$} $newpwd {\1} glob(${inst},pwd)
      break
    }
  }
  # End of while

  if { [IsFTP $tmp2] } {
    set r [regexp {ftp://([^/]*)(.*)} \
	       $glob(${inst},newpwd_oldpwd) match \
	       ftpI newpwd]
    if { $r == 0 } { 
      PopError "Malformed URL $glob(${inst},newpwd_oldpwd) (fatal)"
      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(win,$inst).frame_listb.listbox1 yview] 0]
#  set curdir [lindex [lindex $glob($inst,dirstack) 0] 0]
#  set glob($inst,dirstack) [lreplace  $glob($inst,dirstack) 0 0 "$curdir $oldy"]
  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 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 CreateHotListMenu { inst } {
  global glob 
  Log "createing $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
        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
  }
  set r [catch {read -nonewline $fid} content]
  if {$r != 0} {
    PopError "$content"
    catch {close $fid}
    return
  }
  close $fid
  ViewString "Viewing $filename" content $filename
}

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 \
      -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) \
      -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
  menu $w.text.p -tearoffcommand "AnchorTearoff $w" -title "$title"
  $w.text.p add command -label Search... -command "SearchView $w.text 0"
  $w.text.p add command -label {Search Again} -command "SearchView $w.text 1"
  $w.text.p add command -label {Save As...} -command \
      "SaveToFile $w.text [Esc $filename] 1"
  $w.text.p add command -label Quit -command "destroy $w"
  wm transient $w.text.p $w
  bind $w.text <3> "tk_popup $w.text.p %X %Y"
  bind $w <Escape> "destroy $w"
  bind $w <Next> "$w.text yview scroll 1 pages"
  bind $w <Prior> "$w.text yview scroll -1 pages"
  bind $w <1> "bind $w \<Next\> \"\" ; bind $w \<Prior\> \"\""
  bind $w <Home> "$w.text see 0.0"
  bind $w <End> "$w.text see end"
  bind $w.text $config(mwheel,neg) \
      "$w.text yview scroll -$config(mwheel,delta) units"
  bind $w.text $config(mwheel,pos) \
      "$w.text yview scroll $config(mwheel,delta) units"
  return $w
}

proc AnchorTearoff {w menu tearoff } {
  wm transient $tearoff $w
}
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 0]
    if {$filename == ""} return
  } else {
    if {$filename == ""} {PopError "Null filename"}
  }
  Log "Saving to $filename"
  Try { set fid [open $filename w]
        puts -nonewline $fid [$w get 0.0 end]
        close $fid} "" 1
}


proc SearchView { w again } {
  global glob config
  if {!$again} {
    set s [EntryDialog $w "Search..."\
       "Enter text to search for" $glob(searchstring) question]
    if {$s == ""} return
    set glob(searchstring) $s
    $w mark set insert 0.0
  }

  set tag select
  $w tag configure $tag -background $config(gui,color_select_bg) -foreground $config(gui,color_select_fg) 
  $w tag remove $tag 0.0 end
  set idx [$w search -count len -nocase -- $glob(searchstring) insert]
  if {$idx == ""} {
    PopInfo "$glob(searchstring) not found"
    return
  }
  $w tag add $tag $idx "$idx + $len chars"
  $w mark set insert "$idx + $len chars"
  $w see insert
}


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

  set w .toplevel_$glob(toplevelidx)
  toplevel $w
  wm title $w "Editing $filename"
  wm iconname $w "Editing $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 \
      -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\
       $filename to text.\nOld size: $size_file\nNew Size: $size_text"
  }
  $w.text mark set insert 0.0
  menu $w.text.p  -tearoffcommand "AnchorTearoff $w" -title "Edit $filename"
  $w.text.p add command -label Search... -command "SearchView $w.text 0"
  $w.text.p add command -label {Search Again} -command "SearchView $w.text 1"
  $w.text.p add command -label {Save}\
      -command "SaveToFile $w.text [Esc $filename] 0"
  $w.text.p add command -label {Save As...}\
      -command "SaveToFile $w.text [Esc $filename] 1"
  $w.text.p add command -label {Save&Quit}\
      -command "SaveEditedText [Esc $filename] $w \"$scriptWhenDone\""
  $w.text.p add command -label Quit -command "destroy $w"
  bind $w.text <3> "tk_popup $w.text.p %X %Y"
  bind $w <Escape> "EditTextCheckPoint [Esc $filename] $w \"$scriptWhenDone\""
  bind $w <Next> "$w.text yview scroll 1 pages"
  bind $w <Prior> "$w.text yview scroll -1 pages"
  bind $w <Home> "$w.text see 0.0"
  bind $w <End> "$w.text see end"
  bind $w.text $config(mwheel,neg)\
      "$w.text yview scroll -$config(mwheel,delta) units"
  bind $w.text $config(mwheel,pos) \
      "$w.text yview scroll $config(mwheel,delta) units"
}

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

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

proc EntryDialog { wm wm_title info_text start_entry \
		       {icon ""} {createdir 0}  } {
  global glob config

  set w .entry_dialog
  toplevel $w -class Dialog
  wm title $w $wm_title
  wm iconname $w $wm_title
  wm resizable $w true false
  if { $wm == "" } {
    set wt [winfo toplevel [winfo parent $w]]
    set wp $w
  } else {
    set wt [set wp $wm]
  }
  wm transient $w $wt
# Try this... Duh, not useful.
 # wm attributes $w -topmost

  frame $w.bot
  entry $w.entry -highlightthickness 1 \
      -font $config(gui,ListBoxFont) \
      -background $config(gui,color_bg) \
      -foreground $config(gui,color_fg) \
      -width 70 \
      -selectbackground $config(gui,color_select_bg) \
      -selectforeground $config(gui,color_select_fg)
  $w.entry delete 0 end
  $w.entry insert end $start_entry

  set text_length [string length $info_text]
  set info_text [string range $info_text 0 1000]
  if {$text_length > [string length $info_text]} {
    set info_text "$info_text\n\n...etc..."
  }

  label $w.bot.info_text -justify left -text "$info_text"  -wraplength 5i
  #  label $w.info_text -justify left -text "$info_text\nReturn activates, escape or window-delete cancels."

  button $w.bot.ok -text OK -command { 
    set glob(entry_dialog_return) [.entry_dialog.entry get]
    destroy .entry_dialog
  }
  button $w.bot.cancel -text Cancel -command { 
    set glob(entry_dialog_return) {}
    set glob(abortcmd) 1
    destroy .entry_dialog
  }

  pack $w.bot -side bottom -expand 1 -fill x
  pack $w.bot.cancel -side right -anchor s
  pack $w.bot.ok -side right -anchor s

  if {$createdir} {
    button $w.bot.create -text Create -command { 
      set glob(entry_dialog_return) [.entry_dialog.entry get]
      set r [regexp {ftp://([^/]*)(.*)}\
		 $glob(entry_dialog_return) match ftpI dir]
      if {$r} {
        Try { FTP_MkDir $ftpI "$dir" } "" 1
      } else {
        Try { file mkdir $glob(entry_dialog_return) } "" 1
      }
      destroy .entry_dialog
    }
    pack $w.bot.create -side right -anchor s
  }

  if {$icon != ""} {
    label $w.bot.icon -bitmap $icon 
    pack $w.bot.icon -side left -padx 20 -anchor n -pady 2
  }
  pack $w.bot.info_text -side left -fill x -expand 1 -anchor w

#-padx 8 -pady 5

  pack $w.entry -side bottom -padx 8 -pady 8 -expand 1 -fill x

  set glob(entry_dialog_return) {}

  bind $w.entry <Return> {
    set glob(entry_dialog_return) [.entry_dialog.entry get]
    destroy .entry_dialog
  }

  bind $w.entry <KP_Enter> {
    set glob(entry_dialog_return) [.entry_dialog.entry get]
    destroy .entry_dialog
  }

  bind $w.entry <Escape> {
    set glob(entry_dialog_return) {}
    set glob(abortcmd) 1
    destroy .entry_dialog
  }

  wm withdraw $w
  update idletasks
  set pw [winfo parent $wp]
  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(entry_dialog_return)
}

proc FTPEntryDialog { wm_title info_text start_entry } {
  global glob config

  set w .ftp_entry_dialog
  toplevel $w -class Dialog
  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_text\n\nReturn activates, escape or window-delete cancels."
  pack "$w.info_text" -anchor w -side top -padx 8 -pady 5

  label $w.us -text Username:
  pack $w.us -side top -anchor w -padx 8

  entry $w.entry -highlightthickness 1 -font $config(gui,ListBoxFont)\
      -background $config(gui,color_bg)\
      -foreground $config(gui,color_fg)\
      -width 70\
      -selectbackground $config(gui,color_select_bg)\
      -selectforeground $config(gui,color_select_fg)
  $w.entry delete 0 end
  $w.entry insert end $start_entry
  pack $w.entry -anchor w -side top -padx 8 -pady 4 -expand 1 -fill x

  label $w.pw -text Password:
  pack $w.pw -side top -anchor w -padx 8

  entry $w.entry2 -highlightthickness 1 -show "*"\
      -font $config(gui,ListBoxFont) \
      -background $config(gui,color_bg) \
      -foreground $config(gui,color_fg) \
      -width 70 -selectbackground $config(gui,color_select_bg)\
      -selectforeground $config(gui,color_select_fg)
  $w.entry2 delete 0 end
  $w.entry2 insert end ""
  pack $w.entry2 -anchor w -side top -padx 8 -pady 4 -expand 1 -fill x

  set glob(ftp_entry_dialog_return) {}

  bind $w.entry <Return> {
    set glob(ftp_entry_dialog_return) \
	" [.ftp_entry_dialog.entry get] [.ftp_entry_dialog.entry2 get] "
    destroy .ftp_entry_dialog
  }

  bind $w.entry <Escape> {
    set glob(ftp_entry_dialog_return) {}
    destroy .ftp_entry_dialog
  }

  bind $w.entry2 <Return> {
    set glob(ftp_entry_dialog_return)\
	" [.ftp_entry_dialog.entry get] [.ftp_entry_dialog.entry2 get] "
    destroy .ftp_entry_dialog
  }

  bind $w.entry2 <Escape> {
    set glob(ftp_entry_dialog_return) {}
    destroy .ftp_entry_dialog
  }

  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)
  set glob(enableautoupdate) 0
  tkwait window $w
  catch {focus $oldFocus}
  if {$oldGrab != ""} {
    frgrab $oldGrab
  }
  set glob(enableautoupdate) $oldena
  return $glob(ftp_entry_dialog_return)
}

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
  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 \
      -font $config(gui,ListBoxFont) \
      -background $config(gui,color_bg) \
      -foreground $config(gui,color_fg) \
      -width 70 \
      -selectbackground $config(gui,color_select_bg) \
      -selectforeground $config(gui,color_select_fg)
  $w.entry delete 0 end
  $w.entry insert end $start_entry1
  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\
       -show "*" \
      -font $config(gui,ListBoxFont) \
      -background $config(gui,color_bg) \
      -foreground $config(gui,color_fg) \
      -width 70 \
      -selectbackground $config(gui,color_select_bg) \
      -selectforeground $config(gui,color_select_fg)
  $w.entry2 delete 0 end
  $w.entry2 insert end $start_entry2
  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 ViewAny { filenamelist } {
  global glob config
  set firstfile [lindex $filenamelist 0]
  #puts "file is >$firstfile<"
  set found ""
  foreach k $config(view,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 {
        catch { eval eval exec [format [lindex $k 0] [Esc $file]] } out
        ViewString "Viewing $file" out ""
      }
    } else {
      # list needs to be escaped...
      foreach f $filenamelist {
        lappend f2 [Esc $f]
      }
      Try {eval eval eval exec [format [lindex $k 0] $f2] &} "" 1
    }
    return
  }
  foreach filename $filenamelist {
    ViewText "$filename"
  }
}


proc UnArcAny { file dir } {
  global config glob
  set found ""
  foreach k $config(cmd,unarc,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 unarchive rule for $file"
    return
  }
  Try { cd $dir; eval eval exec \
	    [format [lindex $k 0] [Esc $file]] } "" 1 $glob(async)
}

proc UnPackAny { file } {
  global config glob
  set found ""
  foreach k $config(cmd,unpack,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 unpack rule for $file"
    return
  }
  Try { eval eval exec [format [lindex $k 0] [Esc $file]] } "" 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
}


proc PopInfo { info } {
  tk_dialog_fr .apop "Info" "$info" "" 0 "OK"
  #LogSilent "**Info**\n$info"
}

proc PopWarn { warn } {
  tk_dialog_fr .apop "Warning" "$warn" "" 0 "OK"
  LogStatusOnly "[lindex [split $warn \n] 0]"
  LogSilent "**Warning**\n$warn"
}

proc PopError { error } {
  global glob
#  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)] == 0 } { 
    set glob(errorWindow) [ViewString "**Error**" er ""]
#    puts "window name is >$glob(errorWindow)<"
    wm protocol  $glob(errorWindow) WM_DELETE_WINDOW \
	"wm withdraw $glob(errorWindow)"
    $glob(errorWindow).fr.quit configure \
	-command "wm  withdraw $glob(errorWindow)"
    $glob(errorWindow).text.p entryconfigure last \
	-command "wm  withdraw $glob(errorWindow)"
    $glob(errorWindow).text.p insert 1 command \
	-label {Clear error window} \
	-command "$glob(errorWindow).text delete 0.0 end"
    bind $glob(errorWindow)  <Escape> "wm  withdraw $glob(errorWindow)"
  }
  $glob(errorWindow).text mark set insert end
  $glob(errorWindow).text insert end "\n=============\n$error"
  $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$error"
}

proc PopErrorSimple { error } {
  tk_dialog .apop "**Error**" "$error" "" 0 "OK"
}

proc Try { tryscript excuse alsoPrintErrorInfo {async 0} } {
  #puts "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 $tryscript} outp ]
  if {$r == 0} {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 tk_dialog_fr {w title text bitmap default args} {
  global tkPriv config glob

  # 1. Create the top-level window and divide it into top
  # and bottom parts.

  catch {destroy $w}
  toplevel $w -class Dialog
  wm title $w $title
  wm iconname $w Dialog
  wm attributes $w -topmost
  wm protocol $w WM_DELETE_WINDOW { }
  wm transient $w [winfo toplevel [winfo parent $w]]
  frame $w.top -relief raised -bd 1
  pack $w.top -side top -fill both
  frame $w.bot -relief raised -bd 1
  pack $w.bot -side bottom -fill both

  # 2. Fill the top part with bitmap and message (use the option
  # database for -wraplength so that it can be overridden by
  # the caller).

  #option add *Dialog.msg.wrapLength 3i widgetDefault
  set text_length [string length $text]
  set text [string range $text 0 1000]
  if {$text_length > [string length $text]} {
    set text "$text\n\n...etc..."
  }
  label $w.msg -justify left -text $text \
      -font $config(gui,ListBoxFont) -wraplength 700
  #-Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-*
  pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
  if {$bitmap != ""} {
    label $w.bitmap -bitmap $bitmap
    pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
  }

  # 3. Create a row of buttons at the bottom of the dialog.

  set i 0
  foreach but $args {
    button $w.button$i -text $but -command "set tkPriv(button) $i"
    if {$i == $default} {
      frame $w.default -relief sunken -bd 1
      raise $w.button$i $w.default
      pack $w.default -in $w.bot -side left -expand 1 -padx 3m -pady 2m
      pack $w.button$i -in $w.default -padx 2m -pady 2m
      bind $w <Return> "$w.button$i flash; set tkPriv(button) $i"
    } else {
      pack $w.button$i -in $w.bot -side left -expand 1 \
          -padx 3m -pady 2m
    }
    incr i
  }

  # 4. Withdraw the window, then update all the geometry information
  # so we know how big it wants to be, then center the window in the
  # display and de-iconify it.

  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

  # 5. Set a grab and claim the focus too.

  set oldFocus [focus]
  set oldGrab [grab current $w]
  if {$oldGrab != ""} {
    set grabStatus [grab status $oldGrab]
  }
  frgrab $w
  if {$default >= 0} {
    focus $w.button$default
  } else {
    focus $w
  }

  # 6. Wait for the user to respond, then restore the focus and
  # return the index of the selected button.  Restore the focus
  # before deleting the window, since otherwise the window manager
  # may take the focus away so we can't redirect it.  Finally,
  # restore any grab that was in effect.

  set oldena $glob(enableautoupdate)
  if {$oldena != 0 } {
    set glob(enableautoupdate) 0
  }
  tkwait variable tkPriv(button)
  if { $glob(enableautoupdate) != $oldena} {
    set glob(enableautoupdate) $oldena
  }
  catch {focus $oldFocus}
  destroy $w
  if {$oldGrab != ""} {
    frgrab $oldGrab
  }
  return $tkPriv(button)
}

proc StartTerm { dir inst } {
  global config
  Try { cd $dir; eval exec $config(cmd,term) & } "" 1
}

# Make sure link is open, don't open it if it is already open
proc OpenFTP { ftpI } {
  global glob config env
  set ftpIleft ""
  set ftpIright ""
  set rl [regexp {ftp://([^/]*)(.*)} $glob(left,pwd) match ftpIleft directory]
  set rr [regexp {ftp://([^/]*)(.*)} $glob(right,pwd) match ftpIright directory]
  if {$ftpIleft == $ftpI || $ftpIright == $ftpI} {
    # Link already open
    return ""
  }
  Log "Opening FTP connection to $ftpI"

  # first see if we can find a match in the config(ftp,site_usage) rule list
  foreach k $config(ftp,login) {
    if {[string match [lindex $k 0] $ftpI]} {
      set user [lindex [lindex $k 1] 0]
      set passwd [lindex [lindex $k 1] 1]
      set proxy [lindex $k 2]
      set initcmd [lindex $k 3]
      if {$passwd == "XXX"} {
        set t [FTPEntryDialog \
		   "FTP Login" \
		   "Connecting to $ftpI: Please enter password" \
		   $user]
        if {$t == ""} {
          error "ABORT_FTP_LOGIN_PLEASE"
        }
        set passwd [lindex $t 1]
      }
      if { $user == "" } {
        set user $config(ftp,user)
      }
      if { $passwd == "" } {
        set passwd $config(ftp,password)
      }
      if { $proxy != "" } {
        FTP_OpenSession $ftpI $proxy $user@$ftpI $passwd $ftpI $initcmd
        set glob(ftp,$ftpI,host) $proxy
        set glob(ftp,$ftpI,passwd) $passwd
        set glob(ftp,$ftpI,user) $user@$ftpI
      } else {
        FTP_OpenSession $ftpI $ftpI $user $passwd $ftpI $initcmd
        set glob(ftp,$ftpI,host) $ftpI
        set glob(ftp,$ftpI,passwd) $passwd
        set glob(ftp,$ftpI,user) $user
      }
      Log "FTP connection to $ftpI open"
      return
    }
  }
  set user $config(ftp,user)
  set passwd $config(ftp,password)
  if { !$config(ftp,anonymous) } {
    set t [FTPEntryDialog \
	       "FTP Login" \
	       "Connecting to $ftpI: Please enter username and password" \
	       $env(USER)]
    if {$t == ""} {
      error "ABORT_FTP_LOGIN_PLEASE"
    }
    set user [lindex $t 0]
    set passwd [lindex $t 1]
    if { $user == "" } {
      set user $config(ftp,user)
    }
    if { $passwd == "" } {
      set passwd $config(ftp,password)
    }
  }
  if { $config(ftp,proxy) != "" && $config(ftp,useproxy)} {
    FTP_OpenSession $ftpI $config(ftp,proxy) $user@$ftpI $passwd $ftpI ""
    set glob(ftp,$ftpI,host) $config(ftp,proxy)
    set glob(ftp,$ftpI,passwd) $passwd
    set glob(ftp,$ftpI,user) $user@$ftpI
  } else {
    FTP_OpenSession $ftpI $ftpI $user $passwd $ftpI ""
    set glob(ftp,$ftpI,host) $ftpI
    set glob(ftp,$ftpI,passwd) $passwd
    set glob(ftp,$ftpI,user) $user
  }
  Log "FTP connection to $ftpI open"
}



proc ShowRev { } {
  global glob env
  set r [catch {source $glob(conf_dir)/version} out]
  if {$r} {
    set version 0.0
  }
  if {![string equal -length 10 $glob(version) $version]} {
    About
# for now we always show the history on a new rev, even the first one
 #   if {$version != "0.0"} {
      ViewText $glob(lib_fr)/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 $glob(conf_dir)/version"
    }
  }
}

# Make sure link is closed, don't close if in use
proc CloseFTP { ftpI } {
  global glob config
  set ftpIleft ""
  set ftpIright ""
  set rl [regexp {ftp://([^/]*)(.*)} $glob(left,pwd) match ftpIleft directory]
  set rr [regexp {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
  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 $tail in $possible We quit!"
    quit 1
  }
  
  if { ! [info exists glob(doclib_fr)] } {
    set glob(doclib_fr) $glob(lib_fr)
  }
}

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 LogSilent { text } {
  global glob config
  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]"
  }
}

# This function fixes file names for exec calls to windows apps
# It first converts to the short name format to avoid blanks and 
# then to the native file format and then inserts
# extra '\'s to allow it to move through 'level' eval commands.
# filel is assumed to be a list of file names.
# list is needed in the foreach to handle blanks...

proc FixFileName { filel {level 2}} {
  set prostr [lindex {   {} {\\} {\\\\} {\\\\\\\\} {\\\\\\\\\\\\\\\\} } $level]
  set prostrsp [lindex { { } { } {\ } {\\\ } {\\\\\\\ } {\\\\\\\\\\\\\\\ } } \
		    $level]
#  foreach f [list $filel] {
    set cfile [file nativename  $filel ]
    if { $level != 0 } {
      regsub -all {\\} $cfile $prostr result
      regsub -all { } $result $prostrsp result
    }
#    lappend result $cfile
#  }
  Log "FixFileName level $level from $filel returning $result"
  return $result
}

proc IsFTP { dir } {
  if { [string range $dir 0 5] == "ftp://" } {return 1}
  return 0
}

# Pwd should filter /tmp_mnt stuff out of the path. How well does that work? Not
proc Pwd { } {
  global glob
  if { $glob(os) == "WIN32" } {
    return [pwd]
  }
  return [exec pwd]
#  set r [pwd]
#  if { [string range $r 0 7] == "/tmp_mnt" } {
#    set t [string range $r 8 end]
#    if {$t != ""} {
#      set r $t
#    }
#  }
#  return $r
}

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 $ret)" }
  # 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: $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]"
  } else {
    return "[clock format [clock seconds] -format %d%m%y\ %R]"
  }
}

proc TimeUpdater {} {
  global glob
  $glob(win,top).menu_frame.clock configure -text "[Time]      "
  after 30000 TimeUpdater
}
proc ClearWatch { inst newdir } {
  global glob
  if { $glob(notify,Available)} {
    if {$glob(notify,$inst) != $newdir} {
      if {$glob(notify,left) != $glob(notify,right) } {
	catch {$glob(notify,watchname) remove $glob(notify,$inst)} out
      }
      set glob(notify,$inst) $newdir
      if {$glob(notify,left) != $glob(notify,right) } {
	catch {$glob(notify,watchname) add \
		   $glob(notify,$inst) $glob(notify,flags)} out
      }
    }
  }
}

proc notecallback { {foo 1} } {
  global glob
  set found 0
  while {[$glob(notify,watchname) queue]} {
    set out [$glob(notify,watchname) read]
    foreach ou $out {
      if {[lindex $ou 7] != {} } { 
	set found 1 
	break
      }
    }
  }
  if { $found == 1 } {
    ListUpdater
  }
}
proc WakeListUpdater { {one 1} {two 2} {three 3}} {
  global glob
  if {$glob(enableautoupdate) != 0} {
    trace remove variable glob(enableautoupdate) write WakeListUpdater
    ListUpdater
  }
}

proc ListUpdater {} {
  global glob config
  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"
            LogStatusOnly "Updating $inst panel - done"
            #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
  }
}

proc StartUpdaters {} {
  global glob config
  after 30000 TimeUpdater
  set glob(left,lastmtime) 0
  set glob(right,lastmtime) 0
  catch {set glob(left,lastmtime) [file mtime $glob(left,pwd)]}
  catch {set glob(right,lastmtime) [file mtime $glob(right,pwd)]}
  if {$config(autoupdate)} {
    after [expr $config(autoupdate) * 1000] ListUpdater
  }
}

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

proc CheckCmdLineArgs { } {
  global argv
  set i [lsearch -exact $argv -iconified]
  if {$i < 0} return
  wm iconify .
  set argv [concat [lrange $argv 0 [expr $i - 1]] \
		[lrange $argv [expr $i + 1] end]]
}

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


proc AddToBatchList { inst } {
  global glob
  foreach sel [$glob(win,$inst).frame_listb.listbox1 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]
}

# ------------------------------STARTUP------------------------------------

set glob(start_path) [pwd]
#puts "about to do cmdline args"
CheckCmdLineArgs

FindLibfr
set auto_path [linsert $auto_path 0 $glob(lib_fr) ]

#puts "about to do set platform"

set glob(notify,Available) 0

global tcl_platform
#puts "set up inotify"
if { $tcl_platform(platform) != "unix" } {
  set glob(os) WIN32
} else {
  set glob(os) Unix
#  puts "test if linux"
  if { $tcl_platform(os) == "Linux" } {
    # We attempt to use the inotify thingy....
    # This could be complicated, but we will keep it simple
    # We only watch the two dirs we are interested in
    # if we catch a notify, we will check and update both
    # We continue to depend on the update time to prune
    # unneeded updates....
#    puts "versions of inotify [package versions inotify]"
    set r [catch {package require -exact inotify 1.3.1} out]
    set glob(notify,Available) [expr {$r == 0} ]
    if { $r == 0 } {
      inotify create notifywatch notecallback
      set glob(notify,watchname) notifywatch
      set glob(notify,flags) "naCmd"
    } else {
      puts "$out"
    }
    set glob(notify,left) [set glob(notify,right) ""]
  }
}
set glob(notify,left) [set glob(notify,right) ""]
set glob(init_done) 0

#puts "about to do home"
if { ! [info exists env(HOME)] } {
  PopErrorSimple "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"

set config(usercommands) ""
if { [file exists $glob(conf_dir)/cmds ] } {
  set r [catch { source $glob(conf_dir)/cmds } out]
  if { $r != 0 } {
    PopErrorSimple "Error loading code from $glob(conf_dir)/cmds:\n\n$out"
    exit 1
  }
}
# Each entry consist of a label, the "-command", the variable and 
# the balloon help message
set fast_checkboxes {
  {{Balloon Help} {} config(balloonhelp) \
       {[_ "Toggles the Balloon Help feature (what you are looking at)." ]}}
  {{Show All Files} ForceUpdate config(fileshow,all) \
       {[_ "Toggles the show all files flag.\nIf\
            off 'hidden' files are not showen." ] }}
  {{Create Relative Links} {} config(create_relative_links)\
       {[_ "Toggles the create relative links flag" ]}}
  {{Run Pwd After Cd} {} config(cd_pwd) \
       {[_ "Toggles the do pwd after cd flag" ]}}
  {{Run Pwd After Cd (FTP)} {} config(ftp,cd_pwd) \
       {[_ "Toggles the do pwd on FTP directroies after cd flag" ]}}
      {{Focus Follows Mouse} {after 1 "if {$config(focusFollowsMouse)== 1} \
                         {tk_focusFollowsMouse} "} \
	   config(focusFollowsMouse) \
	   {[_ "Toggles Focus Follows Mouse flag.\nTakes\
                effect immeadiatly if turned on. \nRequires\
                restart if turned off." ]}}
  {{Anonynomous Ftp}  {} config(ftp,anonymous) \
       {[_ "Toggles the Anonynomous FTP flag.\nIf \
           set FTP login is Anonynomous,\nelse \
           use rule based log in." ]}}
  {{Use FTP Proxy} {} config(ftp,useproxy) \
       {[_ "Toggles the FTP Proxy flag.  If set use Proxy." ]}}
}

set r [catch {package require http 2.0} out]
if {$r} {
  PopErrorSimple "Error loading HTTP package:\n\n$out"
  exit 1
}
set glob(left,listhead) ""
set glob(right,listhead) ""
#unset out r f
#puts "about to do list of setup"
FTP_InvalidateCache
CheckConfigDir
InitConfig
ReadConfig
#ConfigFonts
ShowWindow
InitWindows
InitBindings
ConfigPwd
StartUpdaters
Log "Welcome to FileRunner v$glob(version).\
     Copyright (C) 2010 Tom Turkey.\
     Copyright (C) 1996-1999 Henrik Harmsen."

ShowRev

set glob(init_done) 1

