# FileDialog procedures

proc FDreadfiles {} {
  global fd

  .td.mid.file delete 0 end
  .td.mid.files delete 0 end
  .td.mid.dirs delete 0 end
  set fd(lfiles) {}
  set fd(ldirs) {}
  foreach i [lsort [glob -nocomplain *$fd(ext)]] {
    catch {
      if [file isfile ./$i] {
        .td.mid.files insert end $i
        lappend fd(lfiles) $i
      }
    }
  } 
  foreach i [lsort [glob .* *]] {
    catch {
      if [file isdir ./$i] {
        .td.mid.dirs insert end $i
        lappend fd(ldirs) $i
      }
    }
  }
}

proc FDChangeDir {i} {
  global fd env

  cd ./[.td.mid.dirs get $i]
  set fd(pwd) [pwd]
  if {[string first $env(HOME) $fd(pwd)] == 0} {
    set fd(pwd) "~[string range $fd(pwd) [string length $env(HOME)] end]"
  }
  FDreadfiles 
  set fd(selfile) 0
  FDSelect .td.mid.dirs 0
}

proc FDSetFile {i} {
  global fd

  .td.mid.file delete 0 end
  .td.mid.file insert 0 [.td.mid.files get $i]
  FDSelect .td.mid.files $i
}

proc FDSelect {w i} {
  global fd

  $w selection clear 0 end
#  $w selection anchor $i
  $w selection set $i $i
  $w activate $i
  if {$w == ".td.mid.files"} {
#    set l [.td.mid.sbf get]
    set fd(selfile) $i
    set l [.td.mid.files get $i]
    set fd(fn) $l
  } else {
#    set l [.td.mid.sbd get]
    set fd(seldir) $i
  }
  $w see $i
}

proc FDLetter {w a} {
  global fd

  if {$a < " " || $a > "z"} {return}
  if {$w == ".td.mid.files"} {
    set l $fd(lfiles)
  } else {
    set l $fd(ldirs)
  }
  set i [lsearch -glob $l ${a}*]
  if {$i > -1} {
    FDSelect $w $i
  } else {
    puts -nonewline \a
  }
}

proc FDFocusFiles {} {
  global fd

  focus .td.mid.files
  .td.mid.dirs select clear 0 end
  FDSelect .td.mid.files $fd(selfile)
}

proc FDFocusDirs {} {
  global fd

  focus .td.mid.dirs
  .td.mid.files select clear 0 end
  FDSelect .td.mid.dirs $fd(seldir)
}

proc FDFocusFile {} {
  focus .td.mid.file
  .td.mid.files select clear 0 end
  .td.mid.dirs select clear 0 end
}

proc FDOK {} {
  global fd

  set f [.td.mid.file get]
  if {$f != ""} {
    set fd(return) 1
  } else {
    FDFocusFiles
  }
}

proc FDCancel {} {
  global fd
  set fd(return) 0
}

proc FDSelectBox {w} {
  FDSelect $w [$w index active]
}

proc FileDialog {geom atitle {ext ""} filename} {
  global fd env
  upvar $filename fn

  toplevel .td 
  wm transient .td .
  wm geometry .td $geom 
  wm title .td "Select File"
  frame .td.top -relief raised -bd 1
  frame .td.mid -relief raised -bd 1
  frame .td.ext -relief raised -bd 1
  frame .td.bot -relief raised -bd 1
  pack .td.top .td.mid .td.ext .td.bot -fill x

  label .td.top.title -text $atitle
  pack .td.top.title

  label .td.mid.lf -text "File:"
  entry .td.mid.file -relief sunken -textvariable fd(fn)
  listbox .td.mid.files -yscroll ".td.mid.sbf set" -relief sunken \
    -exportselection no
  scrollbar .td.mid.sbf -command ".td.mid.files yview" -takefocus 0
  grid .td.mid.lf -row 0 -column 0
  grid .td.mid.file -row 1 -column 0 -columnspan 2 -sticky ew
  grid .td.mid.files -row 2 -column 0 -sticky nsew
  grid .td.mid.sbf -row 2 -column 1 -sticky ns

  label .td.mid.ld -text "Directory:"
  entry .td.mid.dir -relief sunken -textvariable fd(pwd) -width 30
  listbox .td.mid.dirs  -yscroll ".td.mid.sbd set" -relief sunken \
    -exportselection no
  scrollbar .td.mid.sbd -command ".td.mid.dirs yview" -takefocus 0
  grid .td.mid.ld -row 0 -column 2
  grid .td.mid.dir -row 1 -column 2 -columnspan 2 -sticky ew
  grid .td.mid.dirs -row 2 -column 2 -sticky nsew
  grid .td.mid.sbd -row 2 -column 3 -sticky ns
  grid columnconfigure .td.mid 0 -weight 1
  grid columnconfigure .td.mid 2 -weight 1
  grid rowconfigure .td.mid 2 -weight 1

  label .td.ext.lm -text "\[E\]xtension:"
  entry .td.ext.ext -relief sunken -textvariable fd(ext)
  pack .td.ext.lm .td.ext.ext -side left

  frame .td.bot.fok -bd 1 -relief sunken
  button .td.bot.ok -text "OK" -command "FDOK"
  button .td.bot.cancel -text "Cancel" -command "FDCancel"
  pack .td.bot.fok .td.bot.cancel -side left -padx 5 -pady 5
  pack .td.bot.ok -padx 5 -pady 5 -in .td.bot.fok

  foreach w {.td.mid.files .td.mid.dirs .td.mid.sbf .td.mid.sbd \
    .td.mid.lf .td.mid.file .td.mid.ld .td.mid.dir .td.ext.ext} {
    bindtags $w [list .td [winfo class $w] $w]
  }
  foreach w {.td.mid.files .td.mid.dirs} {
    bind $w <Up> {FDSelectBox %W}
    bind $w <Down> {FDSelectBox %W}
    bind $w <Prior> {FDSelectBox %W}
    bind $w <Next> {FDSelectBox %W}
    bind $w <Any-Key> {FDLetter %W %A}
  }
  bind .td.mid.dirs <1> {FDSelect %W [%W nearest %y]; FDFocusDirs}
  bind .td.mid.dirs <Double-1> {FDChangeDir [.td.mid.dirs nearest %y]}
  bind .td.mid.dirs <Return> {FDChangeDir $fd(seldir)}
  bind .td.mid.files <1> {
    FDSetFile [.td.mid.files nearest %y] 
    FDFocusFiles
  }
  bind .td.mid.files <Double-1> {
    FDSetFile [.td.mid.files nearest %y] 
    FDFocusFiles
    FDOK
  }
  bind .td.mid.files <Return> {FDSetFile $fd(selfile); FDOK}
  bind .td.mid.file <Return> {FDOK}

  bind .td.mid.file <Tab> {FDFocusFiles}
  bind .td.mid.files <Tab> {FDFocusDirs}
  bind .td.mid.dirs <Tab> {FDFocusFile}
  bind .td.mid.file <Shift-Tab> {FDFocusDirs}
  bind .td.mid.files <Shift-Tab> {FDFocusFile}
  bind .td.mid.dirs <Shift-Tab> {FDFocusFiles}

  bind .td.ext.ext <Return> "FDreadfiles ; FDFocusFile"
  foreach w \
  {.td.ext.ext .td.mid.dirs .td.mid.dir .td.mid.files .td.mid.file} {
    bind $w <Control-Return> {set fd(return) 1}
    bind $w <Escape> FDCancel
    bind $w <Alt-Any-e>  "focus .td.ext.ext"
  }
  set fd(ext) $ext
  set old_wd [pwd]
  set fd(pwd) [file dirname $fn]
  if {$fd(pwd) == "."} {set fd(pwd) $old_wd}
  if {[string first $env(HOME) $fd(pwd)] == 0} {
    set fd(pwd) "~[string range $fd(pwd) [string length $env(HOME)] end]"
  }
  cd $fd(pwd)
  FDreadfiles
  set fd(fn) [file tail $fn]
  set fd(selfile) 0
  set fd(seldir) 0
  set fd(return) ""
  set oldfocus [focus]
  FDFocusFile
  grab .td
  tkwait variable fd(return)
  grab release .td
  focus $oldfocus
  if $fd(return) {
    if {$fd(fn) != "" && [file extension $fd(fn)] == ""} {
      set fd(fn) $fd(fn)$fd(ext)
    }
    set fn [pwd]/$fd(fn)
  }
  cd $old_wd
  destroy .td
  return $fd(return)
}