proc FileSelection {name parent args} {
  global _wafeWidget
  set managed true

  TransientShell $name $parent \
    destroyCallback "_destroyCallback $name"

  set wClass [lindex [info level 0] 0]
  set _wafeWidget($name) $wClass

  _defaultValue $name filter Filter *
  _defaultValue $name directory Directroy ./
  _defaultValue $name okCallback Callback {puts "<%s> was selected"}
  _defaultValue $name lines Lines 10
  _defaultValue $name boldFont BoldFont \
    -adobe-times-bold-r-*-*-14-*-*-*-*-*-*-*
  _defaultValue $name plainFont PlainFont \
    -adobe-times-medium-r-*-*-14-*-*-*-*-*-*-*
  _defaultValue $name listFont PlainFont \
    -adobe-times-medium-r-*-*-12-*-*-*-*-*-*-*

  for {set i 0;set nargs [llength $args]} {$i<$nargs} {incr i} {
    switch [lindex $args $i] {
      unmanaged   { set managed false }
      filter      { set filter [lindex $args [incr i]] }
      okCallback  { set okCallback [lindex $args [incr i]] }
      lines       { set lines [lindex $args [incr i]] }
      default     { puts stderr "unknown resource [lindex $args $i]" }
    }
  }

  callback $name popupCallback positionCursor 100
  mergeResources topLevel \
    *$name-F*Label.borderWidth 0 \
    *$name-F*Command.font $boldFont \
    *$name-F*Text*editType edit \
    *$name-F*left chainLeft \
    *$name-F*Command.right chainLeft

  Form $name-F $name

  MenuButton $name-DL $name-F \
    label {Change Directory} \
    menuName $name-M \
    font $boldFont \
    right chainLeft \
    translations "#override \n\
      <Btn1Down>: XawPositionSimpleMenu($name-M) XtMenuPopup($name-M)"

  Label $name-FL $name-F \
    label {Filter:} \
    font $boldFont justify right \
    fromHoriz $name-DL right chainLeft
  Text $name-FT $name-F \
    type string string $filter \
    callback "_fsSetDirectory $name \[gV $name-DT label\]" \
    fromHoriz $name-FL right chainRight \
    font $plainFont \
    translations {#override
      <Key>Return: no-op()
    }
  
  set maxWidth [expr [gV $name-DL width]+\
		[gV $name-FL width]+[gV $name-FT width]]

  Label $name-DT $name-F \
    justify left \
    font $plainFont \
    label $directory \
    fromVert $name-DL right chainRight 

  Viewport $name-V $name-F \
    height $lines width $maxWidth \
    allowVert true \
    fromVert $name-DT \
    right chainRight
  List $name-L $name-V \
    defaultColumns 1 \
    font $listFont \
    callback "_fsCallback $name %i %s"

  sV $name-V height [expr [gV $name-L internalHeight]+\
	$lines*([fontHeight $name-L font]+[gV $name-L rowSpacing])]

  Command Cancel $name-F \
    fromVert $name-V \
    callback "popdown $name" 
  Command Ok $name-F \
    callback "_fsOkCallback $name" \
    fromVert $name-V fromHoriz $name-F.Cancel

  _fsSetDirectory $name $directory
  foreach var {filter directory boldFont plainFont listFont lines} {
    trace variable $var w _${wClass}_change
  }
}

proc _FileSelection_change {n1 n2 op} {
  global $n1
  regexp {^(.*),(.*)$} $n2 all name res
  set newValue [set ${n1}($n2)]
  #  puts "name <$name> <$n2> <$res>" 
  switch -exact $res {
    filter {
      sV $name-FT string [set ${n1}($n2)]
      _fsSetDirectory $name [gV $name-DT label]
    }
    directory {
      setValues $name-DT string $newValue
      _fsSetDirectory $name $newValue
    }
    boldFont {
      setValues $name-DL font $newValue
      setValues $name-FL font $newValue
      setValues $name-F.Cancel font $newValue
      setValues $name-F.Ok font $newValue
    }
    plainFont {
      setValues $name-FT font $newValue
      setValues $name-DT font $newValue
    }
    listFont {
      setValues $name-L font $newValue
      _fsSetDirectory $name [gV $name-DT label]      
      foreach w [gV $name-M children] {
	setValues $w font $newValue
      }
    }
    lines {
      sV $name-L height [expr [gV $name-L internalHeight]+\
	$newValue*([fontHeight $name-L font]+[gV $name-L rowSpacing])]
    }
  }
}

proc _fsSetDirectory {name directory} {
  global fsCache
  if {[info exists fsCache($name)] && 
      [string match $fsCache($name) $directory]} {
  } else {
    if [isWidget $name-M] {
      destroyWidget $name-M
      addTimeOut 0 "_fsSetDirectory $name $directory"
      return
    }

    set oldDir [pwd]
    if [string match /* $directory] {
      cd $directory
    } else {
      cd [gV $name-DT label]/$directory
    }
    sV $name-DT label [set fsCache($name) [pwd]]

    if [file isdirectory ../] {set files ../}
    set dirs {}
    foreach f [glob *] {
      if [file isdirectory $f] {
	lappend files $f/
	lappend dirs $f
      } else  {
	lappend files $f
      }
    }
    set fsCache($name,files) [lsort $files]
    cd $oldDir

    SimpleMenu $name-M $name-DL
    set cnt 0
    set path /
    set font [gV $name listFont]
    foreach dir [split $fsCache($name) /] {
      append path $dir/
      SmeBSB $name-M[incr cnt] $name-M \
	label $dir/ callback "_fsSetDirectory $name $path" \
	font $font
    }
    set popupon $cnt
    foreach dir $dirs {
      SmeBSB $name-M[incr cnt] $name-M \
	label ./$dir callback "_fsSetDirectory $name $path/$dir" \
	font $font
    }
    sV $name-M popupOnEntry $name-M$popupon
  }
  set filter [gV $name-FT string]
  foreach f $fsCache($name,files) {
    if {[string match */ $f] || [string match $filter $f]} {
      lappend sfiles $f
    }
  }
  XawListChange $name-L 0 0 1 List $sfiles
  setValues $name-F.Ok sensitive false
}


proc _fsOkCallback {name} {
  set result [XawListShowCurrent $name-L]
  _fsCallback $name [set ${result}(list_index)] [set ${result}(string)]
}

proc _fsCallback {name item selection} {
  if [string match */ $selection] {
    _fsSetDirectory $name $selection
  } else {
    global _FileSelection
    setValues $name-F.Ok sensitive true
    set cmd $_FileSelection($name,okCallback)
    regsub -all %s $cmd $selection cmd
    regsub -all %i $cmd $item cmd
    eval $cmd
  }
}


