dec_filesel.tcl.in

Isolated Speech Recognition Process that using the Linux to run the program

  bindrecursive $w.list.dir	<Enter> {+tkFS_setDefault filter}
  bindrecursive $w.filter	<Enter> {+tkFS_setDefault filter}
  bindrecursive $w.file		<Enter> {+tkFS_setDefault ok}
  bindrecursive $w.list.file	<Enter> {+tkFS_setDefault ok}

  # Only return when the user has supplied a value --------------

  bind $w		<Escape> "$tkFS(bbox).cancel invoke; break"
  bind $tkFS(e,filter)	<Return> "tkFS_filterCommand; break"
  bind $tkFS(e,file)	<Return> "$tkFS(bbox).ok invoke; break"

  $tkFS(e,filter) xview end
  $tkFS(e,file) xview end

  tkFS_filterCommand $tkFS(cwd)

  update idletasks
  set width 350
  wm minsize $w [winfo reqwidth $w] [winfo reqheight $w]
  wm geometry $w ${width}x[winfo reqheight $w]+[expr ([winfo screenwidth $w]-$width)/2]+[expr ([winfo screenheight $w]-[winfo reqheight $w])/2]

  wm deiconify $w
  focus $tkFS(e,file)
  if $arg(grab) { grab set $w }
  tkwait window $w

  if [string length $tkFS(filename)] {
    return $tkFS(filename)
  } elseif $arg(cancelexc) {
    return -code 64 "File Selection Cancelled"
  } else {
    return {}
  }
}

###
# Horizontal Paned Window Procs from code by Ken Corey @ Sun.
###
## pane - given two widgets, pane them inside that parent.
## The widgets should have the same parent and be the only two in the frame.
# ARGS:	left	- the left/upper widget in the pane
#	right	- the right/lower widget pane
# OPTS:	-dynamic	Whether to dynamically resize or to resize only
#			when the user lets go of the handle
#	-fraction	Initial fraction of window to give to the left pane
#	-handle		A widget to use for the handle
#	-orient		Orientation of window (horiz or vert tiling)
#	-parent		A widget other to use for the panes
##
proc pane {left right args} {
  ## left == top, right == bottom
  array set opt {orn hor par {} hnd {} dyn 1 frc 0.4}
  for {set i 0;set num [llength $args];set cargs {}} {$i<$num} {incr i} {
    set arg [string tolower [lindex $args $i]]
    set val [lindex $args [incr i]]
    switch -glob -- $arg {
      -d*	{ set opt(dyn) [regexp -nocase {^(1|yes|true|on)$} $val] }
      -f*	{ set opt(frc) $val }
      -h*	{ set opt(hnd) $val }
      -o*	{ set opt(orn) $val }
      -p*	{ set opt(par) $val }
      default	{ return -code error "unknown option \"$str\"" }
    }
  }
  ## NOTE: Abuse of tkPriv variables (although no conflicts)
  global tkPriv
  if [string match {} $opt(par)] { set opt(par) [winfo parent $left] }
  if [string match h* $opt(orn)] {
    set d1 height; set d2 width; set d3 x; set d4 h; set anc ne
  } else {
    set d1 width; set d2 height; set d3 y; set d4 v; set anc sw
  }
  if [string match {} $opt(hnd)] {
    set opt(hnd) [frame $opt(par)._hand -bd 2 -$d2 4 \
		      -relief raised -cursor sb_${d4}_double_arrow]
  }
  place $left -rel$d1 1
  place $right -rel$d1 1 -rel$d3 1 -anchor $anc
  place $opt(hnd) -rel$d1 1

  bind $opt(hnd) <ButtonPress-1> "
    set tkPriv(x) \[winfo root$d3 $opt(par)\]
    set tkPriv(y) \[winfo $d2 $opt(par)\].0
  "
  bind $opt(hnd) <B1-Motion> "pane_motion %[string toup $d3] \
	$opt(orn) $left $right $opt(par) $opt(hnd) $opt(dyn)"
  if !$opt(dyn) {
    bind $opt(hnd) <ButtonRelease-1> "pane_motion %[string toup $d3] \
	$opt(orn) $left $right $opt(par) $opt(hnd) 1"
  }
    
  pane_place $opt(orn) $opt(frc) $left $right $opt(par) $opt(hnd)
}

proc pane_place {o f l r p h} {
  if [string match h* $o] {
    place $l -relwidth $f
    place $h -relx $f
    place $r -relwidth [expr 0.99-$f]
  } else {
    place $l -relheight $f
    place $h -rely $f
    place $r -relheight [expr 0.99-$f]
  }
}

proc pane_motion {x o l r p h {dyn 0}} {
  global tkPriv
  set f [expr ($x-$tkPriv(x))/$tkPriv(y)]
  puts [list ($x-$tkPriv(x))/$tkPriv(y) == $f]
  if {$f>0.1 && $f<0.9} {
    if $dyn {
      pane_place $o $f $l $r $p $h
    } elseif [string match h* $o] {
      place $h -relx $f
    } else {
      place $h -rely $f
    }
  }
}

# --- BEGINNING OF PRIVATE PROCEDURES ------------

proc tkFS_setDefault b {
  global tkFS

  if [string match $b ok] {
    $tkFS(bbox).filtbrd configure -relief flat
    $tkFS(bbox).default configure -relief sunken
    focus $tkFS(e,file)
  } else {
    $tkFS(bbox).default configure -relief flat
    $tkFS(bbox).filtbrd configure -relief sunken
    focus $tkFS(e,filter)
  }
}

proc tkFS_filterCommand {{dir {}}} {
  global tkFS

  if {[string match $dir {<< PARENT >>}]} {
    tkFS_chdir ..
  } elseif {[string comp $dir {}] && [string comp $dir .]} {
    tkFS_chdir $dir
  } else {
    tkFS_chdir [file dir $tkFS(filter)]
  }

  set filemask  [file tail $tkFS(filter)]
  
  set tkFS(filter)	[file join $tkFS(cwd) $filemask]
  if [file isdir $tkFS(filename)] {
    set tkFS(filename)	$tkFS(cwd)
  } else {
    set tkFS(filename)	[file join $tkFS(cwd) [file tail $tkFS(filename)]]
  }

  $tkFS(l,dir) delete 0 end
  if {![regexp {^(.:)?/$} $tkFS(cwd)] && \
      [string comp [file dir $tkFS(cwd)] $tkFS(cwd)]} {
    $tkFS(l,dir) insert end "<< PARENT >>"
  }
  foreach d [lsort [tkFS_dirlist $tkFS(cwd)]] {
    set d [file tail $d]
    if {[string comp $d .] && [string comp $d ..]} {
      $tkFS(l,dir) insert end $d
    }
  }

  $tkFS(l,file) delete 0 end
  foreach f [lsort [tkFS_filelist $tkFS(cwd) $filemask]] {
    if {![file isdir $f] && [eval $tkFS(filetest)]} {
      $tkFS(l,file) insert end [file tail $f]
    }
  }
  $tkFS(e,filter) xview end
  $tkFS(e,file) xview end
}

proc tkFS_dirlist d {
  global tkFS
  set dirs [glob -nocomplain $d*$tkFS(sep)]
  if $tkFS(hiddendirs) {
    set dirs [concat $dirs [glob -nocomplain $d.*$tkFS(sep)]]
  }
  return $dirs
}

proc tkFS_filelist {d f} {
  global tkFS
  set files [glob -nocomplain $d$f]
  if $tkFS(hiddenfiles) {
    set files [concat $files [glob -nocomplain $d.$f]]
  }
  return $files
}


proc tkFS_chdir d {
  global tkFS tcl_platform

  # tkFS(cwd) is the current directory, with a trailing slash
  switch $d {
    .  {}
    .. {
      set tkFS(cwd) \
	  [string trimr [file dir $tkFS(cwd)] /]/
    }
    default {
      switch $tcl_platform(platform) {
	windows {
	  if [string match ?:* $d] {
	    set tkFS(cwd) $d/
	  } elseif {[string match /* $d]} {
	    set tkFS(cwd) [string index $tkFS(cwd) 0]:$d/
	  } else {
	    append tkFS(cwd) $d/
	  }
	}
	default {
	  if [string match /* $d] {
	    set tkFS(cwd) [string trimr $d /]/
	  } else {
	    append tkFS(cwd) $d/
	  }
	}
      }
    }
  }
  regsub -all {/\./} $tkFS(cwd) {/} tkFS(cwd)
}


# PROCEDURE
#   bindrecursive
#
# DESCRIPTION
#   Binds all widgets beneath a given widget that satisfy a given predicate
#
# ARGUMENTS
#	widget	window to start at
#	event	Pretty obvious,  like <Return>
#	action	Ditto,           like {.foo activate}
#
# RETURN VALUE
#   none
#

proc bindrecursive {w event cmd {self 1}} {
  if $self {bind $w $event $cmd}
  foreach win [winfo children $w] {
    bind $win $event $cmd
    bindrecursive $win $event $cmd
  }
}


# end of file
#