dec_filesel.tcl.in

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

#! @TCL@ -f
# file: dec_filesel.tcl
#
# These procedures used with direct permission from the author, J. Hobbs
#

##
## filesel.tcl
## Tk File Selection Dialog
##
## updates Copyright 1995,1996 Jeffrey Hobbs.
##
## [e-mail], http://www.cs.uoregon.edu/~jhobbs/
##
## source standard_disclaimer.tcl
##
##----------------------------------------------------------------------------
## PROCEDURE
##   tk_filesel VERSION 0.995
##
## DESCRIPTION
##   Implements a directory browser, _without_ using cd.
##
## ARGUMENTS
##	tk_filesel <window pathname> <options>
##
## OPTIONS
## -defaultfile	The default file to return.
##		Defaults to {}
## -directory	The directory which to start in.
##		Defaults to [pwd]
## -filemask	A glob to indicate which files to display.
##		Defaults to *
##		(all (non .*) directories are also shown)
## -filetest	A procedure test to indicate whether the filename
##		should be included in the list.  Must return 0/1.
##		Defaults to all files (1)
## -grab	Takes a Tcl boolean on whether the dialog should do a grab.
##		Defaults to 1.
## -message	A message to the user to be displayed at the top of the browser
##		Defaults to {}
## -childsite	A procedure to eval to place extra widgets in a childsite
##		in the dialog.
## -showhidden	A flag to indicate whether dot files should be included in
##		the search. No value associated with it (present == yes)
## -okbutton	Text to use for accept button.  Defaults to "OK".
## -title	Title of the browser, default to "Select File".
## -cancelexception	A flag to indicate whether Cancel causes an exception
##			(present == yes)
## RETURN VALUE
##   selected_filename	if a file was selected
##   {}			if `Cancel' was chosen (and -cancelexc wasn't present)
##
## ERRORS
##   none
##
## REQUIRES
##   bindrecursive	 for performing a binding on a whole widget subtree
##
## GLOBAL VARIABLES (in global array tkFS)
##   filter		Actual current file filter
##   filename		Actual current filename
##   filetest		Test for acceptable files
##   hiddenfiles	Include .* files?
##   hiddendirs		Include .* directories?
##   bbox		Window path of buttons
##   e,filter		Window path of filter entry field
##   e,file		Window path of file entry field
##   l,dir		Window path of directory listbox
##   l,file		Window path of file listbox
##

proc tk_filesel {w args} {
  global tkFS tcl_platform

  set count 0
  set unix  [string match unix $tcl_platform(platform)]

  array set arg {
    cancelexc	0	childsite	{}
    defaultfile	{}	directory	.
    filemask	*	filetest	{set noop 1}
    message	{}	okbutton	OK
    showhidden	0	title		"Select File"
    grab	1
  }
  set truth {^(1|yes|true|on)$}
  for {set i 0;set num [llength $args]} {$i<$num} {incr i} {
    set key [string tolower [lindex $args $i]]
    set val [lindex $args [incr i]]
    switch -glob -- $key {
      -ca*	{set arg(cancelexc)	1; set i [incr i -1] }
      -ch*	{set arg(childsite)	$val }
      -de*	{set arg(defaultfile)	$val }
      -di*	{set arg(directory)	$val }
      -filem*	{set arg(filemask)	$val }
      -filet*	{set arg(filetest)	$val }
      -g*	{set arg(grab)		[regexp -nocase $truth $val] }
      -m*	{set arg(message)	$val }
      -o*	{set arg(okbutton)	$val }
      -s*	{set arg(showhidden)	1; set i [incr i -1] }
      -t*	{set arg(title)		$val }
      default	{}
    }
  }

  if ![regexp -nocase {^([A-Z]+:)?/.*} $arg(directory)] {
    if [string match ~* $arg(directory)] {
      if [catch {glob $arg(directory)} dir] {
	set arg(directory) [pwd]
	puts $dir
      } else {set arg(directory) $dir}
    } else {
      set arg(directory) [file join [pwd] $arg(directory)]
    }
    regsub -all {/\./} $arg(directory) / arg(directory)
    regsub {/\.?$} $arg(directory) {} arg(directory)
  }

  array set tkFS [list cwd $arg(directory) \
		      filetest    $arg(filetest) \
		      hiddenfiles $arg(showhidden) \
		      hiddendirs  $arg(showhidden) \
		      filter      [file join $arg(directory) $arg(filemask)] \
		      sep	  [string trim [file join . .] .] \
		      filename    $arg(defaultfile) \
		     ]

  toplevel $w -class TkFileSelect
  wm withdraw $w
  wm title $w $arg(title)
  set parentwindow [winfo toplevel [winfo parent $w]]
  wm transient $w $parentwindow
  wm group $w $parentwindow

  ## Check for message

  if [string length $arg(message)] {
    message $w.message -justify center -relief raised \
	-bd 1 -text $arg(message) -width 350 \
	-font *Helvetica-Medium-R*18*
    pack $w.message -fill x -anchor w
  }

  pack [frame $w.filter	-relief raised -bd 1] -fill x
  pack [frame $w.list	-relief raised -bd 1 -height 250] -fill both -expand 1
  if [string comp $arg(childsite) {}] {
    pack [frame $w.child  -relief raised -bd 1] -fill both
    uplevel "set childsite $w.child; $arg(childsite)"
  }
  pack [frame $w.file	-relief raised -bd 1] -fill x
  pack [frame $w.bbox	-relief raised -bd 1] -fill x

  ## BUTTON BOX
  ##
  set tkFS(bbox) $w.bbox
  button $tkFS(bbox).ok -text $arg(okbutton) -width 6 -padx 8 -pady 2 \
      -command "destroy $w"
  button $tkFS(bbox).cancel -text Cancel -width 6 -padx 8 -pady 2 \
      -command "set tkFS(filename) {}; destroy $w"
  button $tkFS(bbox).filter -text Filter -width 6 -padx 8 -pady 2 \
      -command tkFS_filterCommand

  frame $tkFS(bbox).default -relief sunken -bd 1
  frame $tkFS(bbox).filtbrd -relief flat -bd 1
  raise $tkFS(bbox).ok
  raise $tkFS(bbox).filter

  pack $tkFS(bbox).default -side left -expand 1 -padx 4 -pady 4
  pack $tkFS(bbox).ok -in $tkFS(bbox).default -side left \
      -padx 2 -pady 2 -ipadx 2 -ipady 2
  pack $tkFS(bbox).filter -in $tkFS(bbox).filtbrd -side left \
      -padx 2 -pady 2 -ipadx 2 -ipady 2
  pack $tkFS(bbox).filtbrd -side left -expand 1 -padx 4 -pady 4
  pack $tkFS(bbox).cancel -side left -exp 1 -padx 2 -pady 2 -ipadx 2 -ipady 2

  ## FILTER ENTRY
  ##
  set f $w.filter
  set tkFS(e,filter) $f.body.text
  label $f.label -text Filter: -width 8 -anchor w
  frame $f.body -relief groove -bd 1
  entry $f.body.text -textvar tkFS(filter)

  pack $f.label -side left
  pack $f.body -side right -padx 2 -pady 2 -fill x -expand 1
  pack $f.body.text -fill x -expand 1

  ## FILENAME ENTRY
  ##
  set f $w.file
  set tkFS(e,file) $f.body.text
  label $f.label -text Filename: -width 8 -anchor w
  frame $f.body -relief groove -bd 1
  entry $tkFS(e,file) -textvar tkFS(filename)
  
  pack $f.label -side left
  pack $f.body -side right -padx 2 -pady 2 -fill x -expand 1
  pack $tkFS(e,file) -fill x -expand 1

  ## INTERNAL DIRECTORY / FILE PANED WINDOW
  ##
  pane [frame $w.list.dir] [frame $w.list.file]

  ## DIRECTORY LIST
  ##
  set f $w.list.dir
  set tkFS(l,dir)  $f.list
  set tkFS(s,dir)  $f.sy
  label     $f.label -text Directories -anchor c
  scrollbar $f.sx -command "$tkFS(l,dir) xview" -orient h -bd 1 -highlightt 1
  listbox   $tkFS(l,dir) -relief raised -bd 1 -highlightt 1 -exportsel no \
      -yscrollcommand "$f.sy set" -xscrollcommand "$f.sx set"
  scrollbar $tkFS(s,dir) -command "$tkFS(l,dir) yview" -bd 1 -highlightt 1
  if $unix {
    checkbutton $f.hidden -text "Show Hidden" -highlightt 0 -pady 0 \
	-var tkFS(hiddendirs) -command tkFS_filterCommand
  }

  grid $f.label -sticky ew
  grid $tkFS(l,dir) $tkFS(s,dir) -sticky news
  grid $f.sx -sticky ew
  if $unix { grid $f.hidden -sticky ew }
  grid columnconfig $f 0 -weight 1
  grid rowconfig $f 1 -weight 1

  bind $tkFS(l,dir) <Double-Button-1> {
    tkFS_filterCommand [%W get [%W nearest %y]]
  }

  ## FILE LIST
  ##
  set f $w.list.file
  set tkFS(l,file) $f.list
  set tkFS(s,file)  $f.sy
  label     $f.label -text "Files"  -anchor c
  scrollbar $f.sx -command "$tkFS(l,file) xview" -orient h -bd 1 -highlightt 1
  listbox   $tkFS(l,file) -relief raised -bd 1 -highlightt 1 -exportsel no \
      -yscrollcommand "$f.sy set" -xscrollcommand "$f.sx set"
  scrollbar $tkFS(s,file) -command "$tkFS(l,file) yview" -bd 1 -highlightt 1
  if $unix {
    checkbutton $f.hidden -text "Show Hidden" -highlightt 0 -pady 0 \
	-var tkFS(hiddenfiles) -command tkFS_filterCommand
  }

  grid $f.label - -sticky ew
  grid $tkFS(l,file) $tkFS(s,file) -sticky news
  grid $f.sx -sticky ew
  if $unix { grid $f.hidden - -sticky ew }
  grid columnconfig $f 0 -weight 1
  grid rowconfig $f 1 -weight 1

  bind $tkFS(l,file) <ButtonRelease-1> {
    set tkFS(filename) [file join $tkFS(cwd) [%W get [%W nearest %y]]]
    $tkFS(e,file) xview end
  }
  bind $tkFS(l,file) <Double-Button-1> { $tkFS(bbox).ok invoke; break }

  bind $tkFS(bbox).filter	<Enter> {+tkFS_setDefault filter}
  bind $tkFS(bbox).ok		<Enter> {+tkFS_setDefault ok}
  bind $tkFS(bbox).cancel	<Enter> {+tkFS_setDefault ok}