#!/usr/bin/wish -f
#
# Control panel for G.O.D. - Gravitational Orbits Dynamics
#
# by Filippo Portera  & Rossi Claudio
#
# This program is our project for the course of Mathematic Modeling held at the
# Dept. of Computer Science of the University of Venice given by prof. Andrea
# Bergamasco (from the Dept. Environmental Science of the University of Venice
# and CNR - National Council of Researches).

# Permissions to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that this notice appears in all copies.

# This code is distributed in the hope it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. It is provided "as is" without express or implied
# warranty.

# See the file licemse.txt for more


#If you used this program and found it interesting, please let us know.
#
#You can send e-mail to
#
#	fportera@oink.dsi.unive.it
#or to
#	crossi@moo.dsi.unive.it ,

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

# configure widget colors

option add *background LightSteelBlue3
option add *activeBackground LightSkyBlue2
option add *Scale.sliderForeground LightSteelBlue2
option add *Scale.activeForeground LightSkyBlue2
option add *RadioButton.activeForeground PapayaWhip
option add *Scrollbar.foreground LightSteelBlue3
option add *Scrollbar.activeForeground LightSkyBlue2

# if you get an error message like '>font "-adobe-..." doesn't exist'
# delete the following line:
option add *font -adobe-helvetica-medium-r-normal--12-*-*-*-*-*-iso8859-*

# global variables section (only some fo them, the others are loaded and set
# when the default system is loaded )

set filename default.god
set GoOut 0
set IOreq 0
set mass 1
set radius 1
# main frames 

frame .menu -relief raised -borderwidth 1
frame .rest 
pack .menu .rest -side top -fill x 

 
# menu bar 

menubutton .menu.file -text "File" -menu .menu.file.menu
button .menu.new -text "New" -command {putobj} -relief flat
button .menu.conf -text "Configure" -relief flat -command editfile
button .menu.zoom -text "Zoom" -relief flat -command {set zoommode 1}
button .menu.about -text "About" -command "dialog .da {About} \
  {G.O.D. by\n Filippo Portera & Claudio Rossi\n \
fportera@oink.dsi.unive.it \n crossi@moo.dsi.unive.it \n \
Credits to: \n Livio Rossani\n Andrea Torsello\n Albert TrueTable \n \
Adrian Nye \n Mario Jorge Silva}"
button .menu.help -text "Help" -command "dialog .dh {Help} \
{Try to help yourself that God will help you... \n (no help available)}"

pack .menu.file .menu.new .menu.conf .menu.zoom -side left -fill x
pack .menu.help .menu.about -side right

menu .menu.file.menu
 .menu.file.menu add command -label "Open" -command \
	 {fileselect opensystem "Open G.O.D. system:"} 
 .menu.file.menu add command -label "Save" -command \
	 {fileselect savesystem "Save G.O.D. system:"}
 .menu.file.menu add command -label "Exit" -command {set GoOut 1}

# input control frames 

frame .rest.axis -relief raised -borderwidth 1
frame .rest.alg  -relief raised -borderwidth 1
frame .rest.data -relief raised -borderwidth 1
frame .rest.ctrl -relief raised -borderwidth 1
frame .rest.mode -relief raised -borderwidth 1
# frame .rest.zoom -relief raised -borderwidth 1
frame .rest.domain -relief raised -borderwidth 1
pack .rest.axis .rest.alg .rest.mode .rest.data .rest.domain \
 .rest.ctrl  -side left -fill y

# zoom control scale

#label .rest.zoom.label -text "Zoom"
#scale .rest.zoom.scale -relief raised -from 0 -to 100 -width 5 \
# -orient vertical -command {set zoom}
#pack .rest.zoom.label -side top 
#pack .rest.zoom.scale -side bottom -fill y -expand true

# domain setting entries

label .rest.domain.label -text "Domain"
frame .rest.domain.xM
label .rest.domain.xM.l -text "XMax:"
entry .rest.domain.xM.e -relief sunken -width 8 -textvariable xmax
bind .rest.domain.xM.e <Return> { }
frame .rest.domain.xm
label .rest.domain.xm.l -text "XMin:"
entry .rest.domain.xm.e -relief sunken -width 8 -textvariable xmin
bind .rest.domain.xm.e <Return> { }
frame .rest.domain.yM
label .rest.domain.yM.l -text "YMax:"
entry .rest.domain.yM.e -relief sunken -width 8 -textvariable ymax
bind .rest.domain.yM.e <Return> { }
frame .rest.domain.ym
label .rest.domain.ym.l -text "YMin:"
entry .rest.domain.ym.e -relief sunken -width 8 -textvariable ymin
bind .rest.domain.ym.e <Return> { }
frame .rest.domain.zM
label .rest.domain.zM.l -text "ZMax:"
entry .rest.domain.zM.e -relief sunken -width 8 -textvariable zmax
bind .rest.domain.zM.e <Return> { }
frame .rest.domain.zm
label .rest.domain.zm.l -text "ZMin:"
entry .rest.domain.zm.e -relief sunken -width 8 -textvariable zmin
bind .rest.domain.zm.e <Return> { }

pack .rest.domain.label -side top
pack .rest.domain.xm .rest.domain.xM .rest.domain.ym .rest.domain.yM \
  .rest.domain.zm .rest.domain.zM -side top -fill both -anchor e

pack .rest.domain.xm.e .rest.domain.xm.l -side right
pack .rest.domain.xM.e .rest.domain.xM.l -side right
pack .rest.domain.ym.e .rest.domain.ym.l -side right
pack .rest.domain.yM.e .rest.domain.yM.l -side right
pack .rest.domain.zm.e .rest.domain.zm.l -side right
pack .rest.domain.zM.e .rest.domain.zM.l -side right



# cube control scales

 label .rest.axis.label -text "Spinning cube" 
 scale .rest.axis.x -label "X" -from 0 -to 360 -length 180p \
  -orient horizontal -width 5 -command {set xangle} -relief raised 
 scale .rest.axis.y -label "Y" -from 0 -to 360 -length 180p \
  -orient horizontal -width 5 -command {set yangle} -relief raised 
 scale .rest.axis.z -label "Z" -from 0 -to 360 -length 180p \
  -orient horizontal -width 5 -command {set zangle} -relief raised 
# .rest.axis.x set $xangle; .rest.axis.y set $yangle; .rest.axis.z set $zangle
 pack .rest.axis.label .rest.axis.x .rest.axis.y .rest.axis.z -side top
 
# scheme selection buttons

label .rest.alg.label -text "Scheme"
button .rest.alg.exact -bitmap @bitmaps/profbutt \
	-command {set scheme 1; pushs 1}
button .rest.alg.suck -bitmap @bitmaps/suckbutt \
	-command {set scheme 2; pushs 2}
button .rest.alg.art -bitmap @bitmaps/artbutt \
	-command {set scheme 3; pushs 3}

pack .rest.alg.label .rest.alg.exact .rest.alg.suck .rest.alg.art -side top 

# mode selection buttons

label .rest.mode.label -text "Mode"
button .rest.mode.2d -bitmap @bitmaps/mode2d -command {set mode 2; pushm 2}
button .rest.mode.3d -bitmap @bitmaps/mode3d -command {set mode 3; pushm 3}
pack .rest.mode.label .rest.mode.2d .rest.mode.3d -side top 

# parameters section -- gravitational constant

frame .rest.data.kG
label .rest.data.kG.l -text "Gravit. constant:"
entry .rest.data.kG.e -width 12 -relief sunken -textvariable kG 
bind .rest.data.kG.e <Return> { }

# parameters section -- time

frame .rest.data.dt
label .rest.data.dt.l -text "dt:"
entry .rest.data.dt.e -width 12 -relief sunken -textvariable dt 
bind .rest.data.dt.e <Return> { }

# parameters section -- maximum acceleration 

frame .rest.data.maxacc
label .rest.data.maxacc.l -text "Max Acceleration:"
entry .rest.data.maxacc.e -width 12 -relief sunken -textvariable maxacc
bind .rest.data.maxacc.e <Return> { }

# parameters section -- range of colors to use

scale .rest.data.col_amp -label "Palette" -from 1 -to 100 \
 -orient horizontal -width 8 -command {set col_amp}

pack .rest.data.kG .rest.data.dt .rest.data.maxacc \
     .rest.data.col_amp -side top -anchor e -fill x 
pack .rest.data.kG.e .rest.data.kG.l -side right 
pack .rest.data.dt.e .rest.data.dt.l -side right
pack .rest.data.maxacc.e .rest.data.maxacc.l -side right


# frames containing radiobuttons for track, collision and space selection

frame .rest.ctrl.track -relief raised -bd 2
frame .rest.ctrl.cs -relief raised -bd 2
pack .rest.ctrl.track .rest.ctrl.cs -side left -fill both

# track control buttons

label .rest.ctrl.track.label -text "Track"
radiobutton .rest.ctrl.track.none -text "None" -relief flat \
 -variable track -value 1
radiobutton .rest.ctrl.track.vel -text "Velocity" -relief flat \
 -variable track -value 2
radiobutton .rest.ctrl.track.obj -text "Object" -relief flat \
 -variable track -value 3

pack .rest.ctrl.track.label .rest.ctrl.track.none .rest.ctrl.track.vel \
  .rest.ctrl.track.obj -side top -anchor w

# collision control buttons

label .rest.ctrl.cs.label1 -text "Collision" 
radiobutton .rest.ctrl.cs.elast -bitmap @bitmaps/elastic -relief flat \
  -variable collision -value 1
radiobutton .rest.ctrl.cs.stick -bitmap @bitmaps/stick -relief flat \
  -variable collision -value 2
pack .rest.ctrl.cs.label1 .rest.ctrl.cs.elast \
     .rest.ctrl.cs.stick -side top -anchor w

# space control buttons

label .rest.ctrl.cs.label2 -text "Space" 
radiobutton .rest.ctrl.cs.hiper -bitmap @bitmaps/toro.xbm -relief flat \
  -variable space -value 1
radiobutton .rest.ctrl.cs.inf -bitmap @bitmaps/r3 -relief flat \
  -variable space -value 2
pack .rest.ctrl.cs.inf .rest.ctrl.cs.hiper .rest.ctrl.cs.label2 \
    -side bottom -anchor w


# animation control buttons

frame .rest.data.keys
radiobutton .rest.data.keys.rew -bitmap @bitmaps/rewbutt \
            -variable playpressed -value 2
radiobutton .rest.data.keys.play -bitmap @bitmaps/playbutt \
            -variable playpressed -value 1 
radiobutton .rest.data.keys.stop -bitmap @bitmaps/pausebutt \
            -variable playpressed -value 4

pack .rest.data.keys.stop .rest.data.keys.play \
   .rest.data.keys.rew -side right
pack .rest.data.keys -anchor s


# this procedure repacks all the widgets to update them when a system
# is loaded from a file


proc repack {} {
 global mode scheme xangle yangle zangle zoom col_amp filename
 
 pack .menu .rest -side top -fill x 
 pack .menu.file .menu.new .menu.conf .menu.zoom -side left -fill x
 pack .menu.help .menu.about -side right
 pack .rest.axis .rest.alg .rest.mode .rest.data .rest.domain .rest.ctrl \
   -side left -fill y
 pack .rest.axis.label .rest.axis.x .rest.axis.y .rest.axis.z -side top
 pack .rest.alg.label .rest.alg.exact .rest.alg.suck .rest.alg.art -side top
 pack .rest.mode.label .rest.mode.2d .rest.mode.3d -side top 
 pack .rest.ctrl.track .rest.ctrl.cs -side left -fill both

 pack .rest.ctrl.track.label .rest.ctrl.track.none .rest.ctrl.track.vel \
  .rest.ctrl.track.obj -side top -anchor w

 pack .rest.ctrl.cs.label1 .rest.ctrl.cs.elast \
     .rest.ctrl.cs.stick  -side top -anchor w
 pack .rest.ctrl.cs.inf .rest.ctrl.cs.hiper .rest.ctrl.cs.label2 \
    -side bottom -anchor w
 pack .rest.data.keys.stop .rest.data.keys.play \
   .rest.data.keys.rew -side right

 pack .rest.data.kG .rest.data.dt .rest.data.maxacc \
     .rest.data.col_amp -side top -ipady 2 -anchor e -fill x 
 pack .rest.data.keys -anchor s
 pack .rest.data.kG.e .rest.data.kG.l -side right 
 pack .rest.data.dt.e .rest.data.dt.l -side right
 pack .rest.data.maxacc.e .rest.data.maxacc.l -side right
 pack .rest.domain.label -side top
 pack .rest.domain.xm .rest.domain.xM .rest.domain.ym .rest.domain.yM \
   .rest.domain.zm .rest.domain.zM -side top -fill both -anchor e
 pack .rest.domain.xm.e .rest.domain.xm.l -side right
 pack .rest.domain.xM.e .rest.domain.xM.l -side right
 pack .rest.domain.ym.e .rest.domain.ym.l -side right
 pack .rest.domain.yM.e .rest.domain.yM.l -side right
 pack .rest.domain.zm.e .rest.domain.zm.l -side right
 pack .rest.domain.zM.e .rest.domain.zM.l -side right
 pushm $mode
 pushs $scheme
 .rest.axis.x set $xangle
 .rest.axis.y set $yangle
 .rest.axis.z set $zangle
# .rest.zoom.scale set $zoom
 .rest.data.col_amp set $col_amp
  wm title . "G.O.D. Control Panel - $filename"
}



# this procedure creates a dilog box named w with title "title" and text "text"
# and an acknowledgement button

proc dialog { w title text } {
 toplevel $w -class Dialog
 wm title $w $title
 wm geometry $w 260x220
 message $w.msg -text $text -relief raised -bd 1 -justify center
 button $w.b -text "OK" -command "destroy $w" 
 pack $w.msg $w.b -side top -expand 1 -fill both
}


# creates a window for planets/suns placing

proc putobj {} {

 toplevel .putpanel
 wm geometry .putpanel 130x380
 wm title .putpanel "Put Objects"
 global configmode
 global mass radius

 set playpressed 4
 set configmode 1

 label .putpanel.icon -bitmap @bitmaps/mouse.xbm
 frame .putpanel.input -relief raised -bd 2
 button .putpanel.done -text "Done" -bd 3 -command {destroy .putpanel; \
        set configmode 0}
 pack .putpanel.icon .putpanel.input .putpanel.done -side top -fill x


 scale .putpanel.input.scalem -label "mass" -from 0 -to 100 \
   -orient horizontal -width 5 -command {set mass}
 scale .putpanel.input.scaler -label "radius" -from 0 -to 100 \
   -orient horizontal -width 5 -command {set radius}

  .putpanel.input.scalem set $mass
  .putpanel.input.scaler set $radius

 frame .putpanel.input.mass
  label .putpanel.input.mass.label -text "m:"
  entry .putpanel.input.mass.entry  -relief sunken \
	  -textvariable mass 
  bind .putpanel.input.mass.entry <Return> { }

 frame .putpanel.input.radius                                                  
  label .putpanel.input.radius.label -text "r:"
  entry .putpanel.input.radius.entry  -relief sunken \
	  -textvariable radius  
  bind .putpanel.input.radius.entry <Return> { } 

 pack .putpanel.input.scalem .putpanel.input.scaler .putpanel.input.mass \
   .putpanel.input.radius -side top -fill x
 pack .putpanel.input.mass.entry .putpanel.input.mass.label -side right \
	 -fill x
 pack .putpanel.input.radius.entry .putpanel.input.radius.label -side right \
	 -fill x
 
}



# keeps pressed the specified scheme button and raises the others
# also, changes the color of the selected widget

proc pushs {scheme} {

switch $scheme {
    1 {.rest.alg.exact configure -relief sunken -bg LightSteelBlue4
    .rest.alg.suck configure -relief raised -bg LightSteelBlue3
    .rest.alg.art  configure -relief raised -bg LightSteelBlue3 }
    2 {.rest.alg.exact configure -relief raised -bg LightSteelBlue3
    .rest.alg.suck configure -relief sunken -bg LightSteelBlue4
    .rest.alg.art  configure -relief raised -bg LightSteelBlue3 }
    3 {.rest.alg.exact configure -relief raised -bg LightSteelBlue3
    .rest.alg.suck configure -relief raised -bg LightSteelBlue3
    .rest.alg.art  configure -relief sunken -bg LightSteelBlue4 }
 }
}


# keeps pressed the specified mode button, raise the others
# and disable/enable the scales that spin the cube
# also, changes the color of the selected widget

proc pushm {mode} {

if {$mode == 2} {
  .rest.mode.2d configure -relief sunken -bg LightSteelBlue4
  .rest.mode.3d configure -relief raised -bg LightSteelBlue3
  .rest.axis.x configure -state disabled
  .rest.axis.y configure -state disabled
  .rest.axis.z configure -state disabled
  .rest.axis.x configure -fg gray
  .rest.axis.y configure -fg gray
  .rest.axis.z configure -fg gray
  .rest.axis.label configure -fg gray
# .rest.zoom.scale configure -state disabled
# .rest.zoom.scale configure -fg gray
# .rest.zoom.label configure -fg gray
  .rest.ctrl.cs.inf configure -bitmap @bitmaps/r2
  } else {
  .rest.mode.2d configure -relief raised -bg LightSteelBlue3 
  .rest.mode.3d configure -relief sunken -bg LightSteelBlue4
  .rest.axis.x configure -state normal
  .rest.axis.y configure -state normal
  .rest.axis.z configure -state normal
  .rest.axis.x configure -fg black
  .rest.axis.y configure -fg black
  .rest.axis.z configure -fg black
  .rest.axis.label configure -foreground black
#  .rest.zoom.scale configure -state normal
#  .rest.zoom.scale configure -fg black
#  .rest.zoom.label configure -fg black
  .rest.ctrl.cs.inf configure -bitmap @bitmaps/r3
  }
}


# loads a system from the filename specified by the fileselect procedure

proc opensystem {filename} {
 global  kG dt maxacc col_amp track collision space xangle yangle zangle \
	 zoom mode scheme nobjs xmax xmin ymax ymin zmax zmin \
	 vmass vradius px py pz vx vy vz locked IOreq
 set filetype nongod  
 set line ""
 set f [open $filename r]
     gets $f filetype
     if {$filetype != "god_file"} {
	  dialog .dfe {File error} {This seems not to be a valid G.O.D. file}
     } else {
	     while {[gets $f line] >=0} {
	     if {[string index $line 0]!="#"} {
	     set pos [string first = $line] 
	     set varname [string range $line 0 [expr $pos-1]]
	     set value [string range $line [expr $pos+1] end]
#	     puts stdout "$varname : $value"
	     set $varname $value
                   } 
               }
	   }
 close $f
 set IOreq 1
 repack
}

#  loads the default system
opensystem $filename

# saves a system to the filename specified by the fileselect procedure

proc savesystem {filename} {
 global dir kG dt maxacc col_amp track collision space xangle yangle zangle \
	 zoom mode scheme nobjs xmax xmin ymax ymin zmax zmin \
	 vmass vradius px py pz vx vy vz locked IOreq

    if {$nobjs>0} {    
     set IOreq 2
# loop until the C module has set all the variables to their correct value
# before saving...
#    puts stdout "going into to loop..."
#	while {$IOreq==2} { }
#    puts stdout "loop exited"
     set f [open $filename w]
     puts $f god_file
     puts $f "# --- Global settings ---"
     puts $f "kG=$kG" 
     puts $f "dt=$dt" 
     puts $f "maxacc=$maxacc" 
     puts $f "col_amp=$col_amp"
     puts $f "track=$track"
     puts $f "collision=$collision" 
     puts $f "space=$space"
     puts $f "xangle=$xangle" 
     puts $f "yangle=$yangle"
     puts $f "zangle=$zangle"
     puts $f "zoom=$zoom"
     puts $f "mode=$mode"
     puts $f "scheme=$scheme" 
     puts $f "nobjs=$nobjs"
     puts $f "xmin=$xmin" 
     puts $f "xmax=$xmax" 
     puts $f "ymin=$ymin"
     puts $f "ymax=$ymax" 
     puts $f "zmin=$zmin" 
     puts $f "zmax=$zmax"
     puts $f "# ----- Objects ----- "
     for {set i 1} {$i<=$nobjs} {incr i 1} {
	 puts $f "#     -Object $i:" 
	 puts $f "vmass($i)=$vmass($i)"
	 puts $f "vradius($i)=$vradius($i)"
	 puts $f "# Position"
	 puts $f "px($i)=$px($i)"
	 puts $f "py($i)=$py($i)"
	 puts $f "pz($i)=$pz($i)"
	 puts $f "# Velocity"
	 puts $f "vx($i)=$vx($i)"
	 puts $f "vy($i)=$vy($i)"
	 puts $f "vz($i)=$vz($i)"
	 puts $f "locked($i)=$locked($i)"

    } 
 close $f
} else {
    dialog .err {File error} {There is no system to save}
}
} 


# procedure called by the "configure" menu-bar button

proc editfile { } {
 global filename


# to choose your editor uncomment (only) one of the following lines
 
# exec xterm -e emacs $filename 
exec xterm -e joe $filename 
# exec xterm -e vi $filename 
 
  opensystem $filename
}

 
# file control

# fileselect.tcl --
# simple file selector.
#
# Mario Jorge Silva			          msilva@cs.Berkeley.EDU
# University of California Berkeley                 Ph:    +1(510)642-8248
# Computer Science Division, 571 Evans Hall         Fax:   +1(510)642-5775
# Berkeley CA 94720                                 
#
# Copyright 1993 Regents of the University of California
# Permission to use, copy, modify, and distribute this
# software and its documentation for any purpose and without
# fee is hereby granted, provided that this copyright
# notice appears in all copies.  The University of California
# makes no representations about the suitability of this
# software for any purpose.  It is provided "as is" without
# express or implied warranty.
#
# Downloaded from ftp.aud.alcatel.com march, 2nd 1995
# Modified and customized for G.O.D. by Claudio Rossi march, 6th 1995 
# (added the entry named entry2 and entrydescr, their labels and new bindings
# 4 them ; replaced the default cmd proc with savesystem and loadsystem )
#

# this is the default proc called when error is detected
# indicate your own pro as an argument to fileselect

proc fileselect.default.errorHandler {errorMessage} {
    dialog .err {I/O error} \
   {This seems not to be a valid god file...\n ($errorMessage)}
    catch { cd ~ }
}

# this is the proc that creates the file selector box

proc fileselect {
    {cmd fileselect.default.cmd} 
    {purpose "Open file:"} 
    {w .fileSelectWindow} 
    {errorHandler fileselect.default.errorHandler}} {
    catch {destroy $w}

    toplevel $w
    grab $w
    wm title $w "Select File"
    set filename ""

    # path independent names for the widgets
    global fileselect

    set fileselect(entry) $w.file.eframe.entry
    set fileselect(list) $w.file.sframe.list
    set fileselect(scroll) $w.file.sframe.scroll
    set fileselect(ok) $w.bframe.okframe.ok
    set fileselect(cancel) $w.bframe.cancel
    set fileselect(dirlabel) $w.file.dirlabel

    # widgets
    frame $w.file -bd 10 
    frame $w.bframe -bd 10
    pack append $w \
        $w.file {left filly} \
        $w.bframe {left expand frame n}

    frame $w.file.eframe
    frame $w.file.sframe
    label $w.file.dirlabel -anchor e -width 24 -text [pwd] 

    pack append $w.file \
        $w.file.eframe {top frame w} \
	$w.file.sframe {top fillx} \
	$w.file.dirlabel {top frame w}


    label $w.file.eframe.label -anchor w -width 24 -text Filter:
    entry $w.file.eframe.entry -relief sunken
    label $w.file.eframe.label2 -anchor w -width 24 -text $purpose
    entry $w.file.eframe.entry2 -relief sunken -textvariable filename

    pack append $w.file.eframe \
		$w.file.eframe.label {top expand frame w} \
                $w.file.eframe.entry {top fillx frame w} \
		$w.file.eframe.label2 {top expand frame w} \
                $w.file.eframe.entry2 {top fillx frame w} 

    scrollbar $w.file.sframe.yscroll -relief sunken \
	 -command "$w.file.sframe.list yview"
    listbox $w.file.sframe.list -relief sunken \
	-yscroll "$w.file.sframe.yscroll set" 

    pack append $w.file.sframe \
        $w.file.sframe.yscroll {right filly} \
 	$w.file.sframe.list {left expand fill} 

    # buttons
    frame $w.bframe.okframe -borderwidth 2 -relief sunken
 
    button $w.bframe.okframe.ok -text OK -relief raised -padx 10 \
        -command "fileselect.ok.cmd $w $cmd $errorHandler"

    button $w.bframe.cancel -text cancel -relief raised -padx 10 \
        -command "fileselect.cancel.cmd $w"
    pack append $w.bframe.okframe $w.bframe.okframe.ok {padx 10 pady 10}

    pack append $w.bframe $w.bframe.okframe {expand padx 20 pady 20}\
                          $w.bframe.cancel {top}

    # Fill the listbox with a list of the files in the directory (run
    # the "/bin/ls" command to get that information).
    # to not display the "." files, remove the -a option and fileselect
    # will still work
 
    $fileselect(list) insert end ".."
    foreach i [exec /bin/ls -a [pwd]] {
        if {[string compare $i "."] != 0 && \
	    [string compare $i ".."] != 0 } {
            $fileselect(list) insert end $i
        }
    }

   # Set up bindings for the browser.
    bind $fileselect(entry) <Return> {eval $fileselect(ok) invoke}
    bind $fileselect(entry) <Control-c> {eval $fileselect(cancel) invoke}

    bind $w <Control-c> {eval $fileselect(cancel) invoke}
    bind $w <Return> {eval $fileselect(ok) invoke}
    bind $w.file.eframe.entry2 <Control-c> {eval $fileselect(cancel) invoke}
    bind $w.file.eframe.entry2 <Return> {eval $fileselect(ok) invoke}
#    bind $w.file.eframe.entry2 <Escape> {eval $fileselect(cancel) invoke}

    tk_listboxSingleSelect $fileselect(list)


    bind $fileselect(list) <Button-1> {
        # puts stderr "button 1 release"
        %W select from [%W nearest %y]
	$fileselect(entry) delete 0 end
	$fileselect(entry) insert 0 [%W get [%W nearest %y]]
    }

    bind $fileselect(list) <Key> {
        %W select from [%W nearest %y]
        $fileselect(entry) delete 0 end
	$fileselect(entry) insert 0 [%W get [%W nearest %y]]
    }

    bind $fileselect(list) <Double-ButtonPress-1> {
        # puts stderr "double button 1"
        %W select from [%W nearest %y]
	$fileselect(entry) delete 0 end
	$fileselect(entry) insert 0 [%W get [%W nearest %y]]
	$fileselect(ok) invoke
    }

    bind $fileselect(list) <Return> {
        %W select from [%W nearest %y]
	$fileselect(entry) delete 0 end
	$fileselect(entry) insert 0 [%W get [%W nearest %y]]
	$fileselect(ok) invoke
    }

    # set kbd focus to entry widget

    focus $fileselect(entry)

}


# auxiliary button procedures

proc fileselect.cancel.cmd {w} {
    # puts stderr "Cancel"
    destroy $w
}

proc fileselect.ok.cmd {w cmd errorHandler} {
    global filename 
    global fileselect
    set selected [$fileselect(entry) get]

    # some nasty file names may cause "file isdirectory" to return an error
    set sts [catch { 
	file isdirectory $selected
    }  errorMessage ]

    if { $sts != 0 } then {
	$errorHandler $errorMessage

	destroy $w
	return

    }

    # clean the text entry and prepare the list
    $fileselect(entry) delete 0 end
    $fileselect(list) delete 0 end
    $fileselect(list) insert end ".."

    # perform globbing on the selection. 
    # If globing returns an error, return (leaving the file listbox empty)
    # If resulting list length > 1, put the list on the file listbox and return
    # If globing expands to a list of filenames in multiple directories,
    # the indicated regexp is invalid and the error handler is called instead.
  
    set sts [catch {
	set globlist [glob [list $selected]]
    } errorMessage ]

    if { $sts != 0 } then {
	return
    }

    if {[llength $globlist] > 1} {
	if {[regexp "/" $globlist] != 0} {
	    $errorHandler [list "Invalid regular expression, " $selected, "."]
	    destroy $w
	    return
	}
	foreach i $globlist {
	    if {[string compare $i "."] != 0 && \
		[string compare $i ".."] != 0} {
		$fileselect(list) insert end $i
	    }
	}
	return
    }

    # selection may be a directory. Expand it.

    if {[file isdirectory $selected] != 0} {
	cd $selected
	set dir [pwd]
	$fileselect(dirlabel) configure -text $dir

	foreach i [exec /bin/ls  $dir] {
	    if {[string compare $i "."] != 0 && \
		[string compare $i ".."] != 0} {
		$fileselect(list) insert end $i
	    }
	}
	return
    }

    destroy $w  
    if {$selected==""} {
	set selected $filename 
    } else {
	set filename $selected
    } 
    $cmd $selected
   
  
}

