#!/usr/bin/wish -f
#
# startool -- Si-Package tool:
#             Install, Uninstall, run batch and graph mode.
#             created by: Valentin E. Kuznetsov
#             date: September 21, 1997
########################################################################

#### Set title and allow window resizing.
wm title . "STAR package manager"
wm iconname . "startool"
wm geometry . +10+10

#### General settings
set userdir  [pwd]
set workdir  [pwd]
set starfzdir "/pool/star2/STAR_FZ/"
set aug_nus   "/pool/star2/STAR_FZ/aug_nus/"
set aug_mus   "/pool/star2/STAR_FZ/aug_mus/"
set stargraph "/star/stargraph"
set starbatch "/star/star"
set stardir   "/pool/star2/valya/nomad_star/packages/star"
set startar   "/pool/star2/valya/nomad_star/packages/tar/starnew.tar"
set startcl   "/pool/star2/valya/nomad_star/tcl_tk"
set dcdir     "/pool/star2/valya/nomad_star/packages/dc"
set dctar     "/pool/star2/valya/nomad_star/packages/tar/dcnew.tar"
set font      -Adobe-Helvetica-Medium-R-Normal--*-180-*-*-*-*-*-*
set font170   -Adobe-Helvetica-Medium-R-Normal--*-170-*-*-*-*-*-*
set font160   -Adobe-Helvetica-Medium-R-Normal--*-160-*-*-*-*-*-*
set font150   -Adobe-Helvetica-Medium-R-Normal--*-160-*-*-*-*-*-*
set font140   -Adobe-Courier-Bold-R-Normal--*-140-*-*-*-*-*-*
set font130   -Adobe-Courier-Bold-R-Normal--*-130-*-*-*-*-*-*
set font100   -Adobe-Courier-Bold-R-Normal--*-100-*-*-*-*-*-*
set data      /pool/star2/STAR_FZ/aug_mus_jj/r15920_nu.fz
set bgcol     gray85
set fgcol     gray80
set file      "empty"

#### Create a frame for buttons and entry.
frame .top -borderwidth 20 -bg gray85
pack .top -side top -fill x
# -padx 300 -pady 40

#### Create a message text
message .top.msg -aspect 1000 -bg gray85 -text "Si-package Development Kit"
pack .top.msg -side top -fill x

#### Create the Help menu
menubutton .top.mh -padx 3 -pady 2 -relief raised -bg gray85 \
                   -text "Help" -menu .top.mh.menu

set mh [menu .top.mh.menu -tearoff 1]
   $mh add command -label "About"         -command {
           set mes "NOMAD-STAR\nValentin E. Kuznetsov\n\
                    Email: valya@nu.jinr.ru"
           set confirm [tk_dialog .message {Confirm!} $mes warning 0 OK Quit]
           }
   $mh add command -label "How to use"    -command HelpManager
   $mh add command -label "Si-Package"    -command {
           set mes "Not implemented at the moment, sorry"
           set confirm [tk_dialog .message {Confirm!} $mes warning 0 OK Quit]
           }
   $mh add command -label "Communication" -command MailManager

#### Create the Make menu
menubutton .top.mm -padx 3 -pady 2 -relief raised \
                   -bg gray85 -text "Make" -menu .top.mm.menu

set mm [menu .top.mm.menu -tearoff 1]
   $mm add cascade -label Install -menu $mm.sub1
set m1 [menu $mm.sub1 -tearoff 0]
   $m1 add command -label "Si-Package" \
          -command {SiManager $workdir "install"}
   $m1 add command -label "Dc-Package" \
          -command {DcManager $workdir "install"}
   $mm add separator
   $mm add cascade -label Update -menu $mm.sub2
set m2 [menu $mm.sub2 -tearoff 0]
   $m2 add command -label "Si-Package" \
          -command {SiManager $workdir "update"}
   $m2 add command -label "Dc-Package" \
          -command {DcManager $workdir "update"}
   $mm add separator
   $mm add cascade -label Compile -menu $mm.sub3
set m3 [menu $mm.sub3 -tearoff 0]
   $m3 add command -label "Si-Package" \
          -command {SiManager $workdir "compile"}
   $m3 add command -label "Dc-Package" \
          -command {DcManager $workdir "compile"}
   $mm add separator
   $mm add cascade -label Remove -menu $mm.sub4
set m4 [menu $mm.sub4 -tearoff 0]
   $m4 add command -label "Si-Package" \
          -command {SiManager $workdir "remove"}
   $m4 add command -label "Dc-Package" \
          -command {DcManager $workdir "remove"}
   $m4 add command -label "Everything" \
          -command {"/bin/rm -rf $workdir/*"}

#### Create the Run menu
menubutton .top.mr -padx 3 -pady 2 -relief raised \
                   -bg gray85 -text "Run" -menu .top.mr.menu

set mr [menu .top.mr.menu -tearoff 1]
   $mr add command -label "StarGraph" \
          -command {RunManager $stargraph}
   $mr add command -label "FileOpen" -command {
            feedback_sit "Open input file"
            set file [tk_getOpenFile -initialdir $starfzdir]
            feedback_sit ""
           }
   $mr add command -label "StarBatch" -command {RunManager $starbatch}
   $mr add command -label "Send job to NQS" -command SendtoNQS
   $mr add command -label "StatusNQS"       -command StatusNQS
   $mr add command -label "StageTape"       -command StageTape
   $mr add command -label "Status ps"       -command \
                   {Run "ps auxw | grep $env(USER)"}

#### Create the Debug menu
menubutton .top.md -padx 3 -pady 2 -relief raised \
                   -bg gray85 -text "Debug" -menu .top.md.menu

set md [menu .top.md.menu -tearoff 1]
   $md add command -label "StarGraph" \
          -command {DebbugManager $stargraph}
   $md add command -label "StarBatch" \
          -command {DebbugManager $starbatch}

button .top.quit -padx 3 -pady 2 -bg gray85 -text Quit -command exit

# ToolTips popups for the buttons.
if [file exist $startcl/tooltips.tcl] {
    source $startcl/tooltips.tcl
    set_tooltips .top.mh \
       {{Introduction how to use this package}}
    set_tooltips .top.mm \
       {{install, uninstall, update, compile menu}}
    set_tooltips .top.mr \
       {{run Si-package in different mode}}
    set_tooltips .top.md \
       {{run Si-package with debugger in different mode}}
    set_tooltips .top.quit \
       {{Exit of startool}}
}
          
#### Configuration of geometry for buttons and menus
pack .top.quit -ipady 3 -ipadx 10 -padx 20 -side right
pack .top.md   -ipady 3 -ipadx 10 -padx 20 -side right
pack .top.mr   -ipady 3 -ipadx 10 -padx 20 -side right
pack .top.mm   -ipady 3 -ipadx 10 -padx 20 -side right
pack .top.mh   -ipady 3 -ipadx 10 -padx 20 -side right

#### Entry widget used by feedback
frame .bottom; frame .center
pack .bottom   -in .center  -side bottom -fill x
pack .center                -side left   -fill both -expand yes
set feedback(sit) [entry .feedback -width 55]
pack .feedback -in .bottom -side bottom -fill x -expand yes

##############################################################
#### Create startool settings window
set w .settings
toplevel $w
wm title $w "StarTool Settings"
wm geometry $w +300+300
frame $w.top -borderwidth 40 -bg gray85
pack $w.top -side top -fill x
# Create a labeled entry for the install directory
label $w.top.l -text "Enter install directory:" -padx 0 -bg gray85
entry $w.top.cmd -width 50 -relief sunken -bg gray85 \
                      -textvariable workdir
#bind $w.top.cmd <Return> {gets $workdir line}
bind $w.top.cmd <Return> {
      set userdir [file join $workdir "work"]
      destroy $w
}
focus $w.top.cmd 
button $w.top.ok -text Ok -bg gray80 -command {
       if ![file exists [file join $workdir "work"]] {
            eval exec "/bin/mkdir $workdir/work" 
       }
       set userdir [file join $workdir "work"]
       destroy $w
       set confirm [tk_dialog .message {Confirm!} \
       "Your working directori is $workdir,\n\
        all results will be in\n $userdir" \
        warning 0 OK Quit]
}
pack $w.top.l    -side left
pack $w.top.cmd  -side left -fill x -expand true
pack $w.top.ok   -side right
##############################################################

#### Definition of functions are followed below this line ####
#
#### The HelpManager procedure
proc HelpManager { } {
     global font100
     set w .helpmanager
     createWindow $w "Help Manager"

     message $w.top.msg -aspect 300 -font $font100 -bg gray85 -text \
     "This is simple tool to install and start Si package on your site \
     with stable up-date version of Dc as well as Si packages. \
     The Make menu contains: install (cvs checkout of packages), \
     update (cvs update), compile and remove options. Choose one of \
     them for your purpose. The compilations takes some of your time \
     since it run make, please be patient and use only axnd02 machine \
     for this goal to avoid any problems. The Run menu contains \
     stargraph and starbatch program, please chose one of them to run \
     program. In the case of starbatch you need to specify input file \
     from FileOpen menu. The stargraph has familar friendly OnX interface. \
     If you got a crash of your program at some point, you have a \
     possibility to run it again using Debug menu. \
     Everywhere to exit type Quit.\n\n\
     In the case of any problems send me Email with short description \
     of your problem.\nGood luck, Valentin."

     button $w.top.quit -text Quit -command "destroy $w" -bg gray80
     pack $w.top.quit $w.top.msg -side bottom
}

#### The Status Window
proc StatusWindow { textinwindow } {
     global font workdir
     set w .statwin
     createWindow $w "Status Window"

     message $w.msg -aspect 1000 -justify center \
                    -text $textinwindow -font $font -bg gray85
     button $w.top.quit -text Quit -bg gray80 -command "destroy $w"
     pack $w.top.quit $w.msg -side top
}

#### The Install procedure
proc SetWorkDir { } {
     global workdir
     set w .setworkdir
     createWindow $w "Settings"

     # Create a labeled entry for the install directory
     label $w.top.l -text "Enter install directory:" -padx 0 -bg gray85
     entry $w.top.cmd -width 20 -relief sunken -bg gray85 \
                      -textvariable workdir
     bind $w.top.cmd <Return> {gets $workdir line}
     focus $w.top.cmd 
     pack $w.top.l    -side left
     pack $w.top.cmd  -side left -fill x -expand true

     button $w.top.ok -text Ok -bg gray80 -command "destroy $w"
     pack $w.top.ok   -side right
}

#### The RunManager procedure
proc RunManager { com } {
     global stargraph starbatch file env workdir userdir 
     global output redirect redfile f_e f_n f_p
     set events 0; set noise 0; set pedestals 0; 
     set redfile " "
     set f_e ""; set f_n ""; set f_p "";
     set output "Redirect output to"
     set w .runmanager
     createWindow $w "Run Manager"
     cd $userdir

     if { $com == $starbatch } {
         button $w.top.opt -bg gray80 -text "Activate Flags" -command {
                set w2 .flagsmanager
                createWindow $w2 "Activate Flags"
                scale $w2.s1 -from 0 -to 100 -length 400 \
                             -variable events -orient horizontal \
                             -label "# of events" \
                             -tickinterval 10 -showvalue true
                scale $w2.s2 -from 0 -to 400 -length 400 \
                             -variable noise -orient horizontal \
                             -label "# of evt. for noise.data" \
                             -tickinterval 40 -showvalue true
                scale $w2.s3 -from 0 -to 200 -length 400 \
                             -variable pedestals -orient horizontal \
                             -label "# of evt. for pedestals.data" \
                             -tickinterval 20 -showvalue true
                pack $w2.s1 $w2.s2 $w2.s3 -side top
                frame  $w2.left
                pack   $w2.left -side top -expand yes -pady .5c -padx .5c
                foreach redirect {tofile stdout} {
                  set lower [string tolower $redirect]
                  radiobutton $w2.left.$lower -text "$output $redirect" \
                              -variable redirect -value $lower
                  pack $w2.left.$lower -side top -pady 2 -anchor w
                }
                button $w2.b -bg gray80 -text Ok -command "destroy $w2"
                pack   $w2.b -side top
         }
         button $w.top.start -bg gray80 -text Start -command {
                SetEnvironment $workdir
                if {$file == "empty"} {
                    set confirm [tk_dialog .message {Confirm!} \
                    {Please specify input file in [Run->FileOpen] menu} \
                    warning 0 OK Quit]
                } else {
                  if { $events != 0 } {set f_e "-e $events"}
                  if { $noise != 0 } {set f_n "-n $noise"}
                  if { $pedestals != 0 } {set f_p "-p $pedestals"}
                  if {$redirect == "tofile"} {
                    set name [file tail $file]
                    set name [file join $userdir $name]
                    set redfile " >& $name.output"
                  } elseif {$redirect == "stdout"} {
                    set redfile ""
                  }
                  set name "$workdir/$starbatch"
                  set program "$name -i $file $f_e $f_n $f_p $redfile"
                  if [file exist "$name.output"] {
                      eval exec "/bin/rm -f $name.output"
                  }
                  feedback_sit "Running Si-Package in batch mode"
                  Run $program
                  feedback_sit ""
                }
         }
         pack $w.top.start $w.top.opt -side left
     } else {
         button $w.top.start -bg gray80 -text Start -command {
                feedback_sit "Running Si-Package in graph mode"
                SetEnvironment $workdir
                Run "$workdir/$stargraph"
                feedback_sit ""
         }
         pack $w.top.start -side left
     }
     button $w.top.clean  -bg gray80 -text Clean -command {
            feedback_sit "Cleaning"
            eval exec "/bin/rm -f $userdir/qq*"
            eval exec "/bin/rm -f $userdir/fort.50"
            eval exec "/bin/rm -f job.*"
            feedback_sit ""
     }
     button $w.top.quit  -bg gray80 -text Quit -command "destroy $w"
     pack $w.top.clean $w.top.quit -side left
}

#### The DebbugManager procedure
proc DebbugManager { com } {
     global stargraph starbatch file env workdir userdir
     cd $userdir

     if { $com == $starbatch } {
       feedback_sit "Running Si-Package in batch mode using gdb debbuger"
       SetEnvironment $workdir
       eval exec "xterm -e gdb --quiet $workdir/$starbatch"
       feedback_sit ""
     } else {
       feedback_sit "Running Si-Package in graph mode using gdb debbuger"
       SetEnvironment $workdir
       if [catch {open $workdir/$stargraph r} fileId] {
         puts stdout "Cannot open file $workdir/$stargraph: $fileId"
       } else {
         if [file exists "$workdir/env.csh"] {
             eval exec "/bin/rm -f $workdir/env.csh" 
         }
         eval exec "touch $workdir/env.csh"
         eval exec "echo #!/bin/csh -f >> $workdir/env.csh"
         while {[gets $fileId line] >= 0} {
           if [scan $line {%[a-z]} result] { 
            eval exec "echo $line >> $workdir/env.csh"
           }
         }
         eval exec "chmod a+x $workdir/env.csh"
         eval exec "$workdir/env.csh" 
         close $fileId
       }
       eval exec "echo echo USAGE inside of gdb: run -show display.oui >> $workdir/env.csh"
       eval exec "echo gdb --quiet $workdir/star/OSF1/sigraphdev.exe >> $workdir/env.csh"
       cd $workdir/star
       eval exec "xterm -e $workdir/env.csh"
       eval exec "rm -rf qq* fort.50"
       cd $userdir
       feedback_sit ""
     }
}

#### We make position at the center of screen
proc positionWindow w {
     wm geometry $w +300+300
}

#### We create a new Window each time we need
proc createWindow { w wtitle } {
     catch {destroy $w}
     toplevel $w
     wm title $w $wtitle
     positionWindow $w
     frame $w.top -borderwidth 40 -bg gray85
     pack $w.top -side top -fill x
}

#### Create a new widget with scrollbar
proc displayWindow { flytext font {run Running} } {
     global log run_command
     set w .displaymanager
     catch {destroy $w}
     feedback_sit $run
     toplevel $w
     wm title $w "Display Window"
     wm geometry $w +63+280
#     positionWindow $w
     frame $w.t -borderwidth 5 -bg gray85
     pack $w.t -side bottom -fill x

     # Create a frame for text widget
     frame $w.top
     set log [text $w.log -setgrid true -wrap word -width 100 -height 14 \
              -font $font -borderwidth 2 -relief sunken -bg gray85 \
              -yscrollcommand "$w.sy set"]
     scrollbar $w.sy -orient vert -bg gray80 -command "$w.log yview"
     $log insert end $flytext
#     Text_Dump $log stdout
     pack $w.sy -side right -fill y
     pack $w.log -side left -fill both -expand true
     pack $w.top -side top  -fill both -expand true
     feedback_sit ""

     # Create a frame where buttom Quit placed
     button $w.t.quit  -bg gray80 -text Quit -command "destroy $w"
     pack $w.t.quit  -side right
}

#### Install or Update Si-package from CVS repository
proc SiManager { dir com } {
     global env userdir
     SetEnvironment $dir
     set env(CVSROOT) "/nomad/cvsroot"
     if { $com == "install" } {
        feedback_sit "Installing Si-Package, please wait"
        cd $dir
        eval exec "cvs co -r v8r2 star >& /dev/null"
        feedback_sit ""
     } elseif { $com == "update" } {
        feedback_sit "Updating Si-Package, please wait"
        cd $dir/star
        eval exec "cvs up >& /dev/null"
        feedback_sit ""
     } elseif { $com == "remove" } {
        feedback_sit "Removing Si-Package, please wait"
        cd $dir
        eval exec "/bin/rm -rf star >& /dev/null"
        feedback_sit ""
     } elseif { $com == "compile" } {
        if ![file exist $dir/lib] { eval exec "/usr/bin/mkdir $dir/lib" }
        if ![file exist $dir/lib/libdcdev.a] {
          set mes "In order to install Si-package you need first\
                   install Dc-package"
          set confirm [tk_dialog .message {Confirm!} $mes warning 0 OK Quit]
        } else {
          feedback_sit "Compiling Si-Package, please wait"
          cd $dir/star
          eval exec "/usr/local/bin/gmake CC=gcc main graph -f Makefile >& make.log"
          feedback_sit ""
        }
     }
     cd $userdir
}

#### Install or Update Dc-package from CVS repository
proc DcManager { dir com } {
     global env userdir
     if ![file exist ~/.cvspass] {
        eval exec "touch ~/.cvspass"
        set cvspass {:pserver:pariscvs@lpnax1.in2p3.fr:/home/users/nomad/master A+y%d'}
        eval exec "echo $cvspass >> ~/.cvspass"
     }
     SetEnvironment $dir
     set env(CVSROOT) {:pserver:pariscvs@lpnax1.in2p3.fr:/home/users/nomad/master}
     if { $com == "install" } {
        feedback_sit "Installing Dc-Package, please wait"
        cd $dir
        eval exec "cvs co -r v7r7a-star dc >& /dev/null"
        feedback_sit ""
     } elseif { $com == "update" } {
        feedback_sit "Updating Dc-Package, please wait"
        cd $dir/dc
        eval exec "cvs up >& /dev/null"
        feedback_sit ""
     } elseif { $com == "remove" } {
        feedback_sit "Removing Dc-Package, please wait"
        cd $dir
        eval exec "/bin/rm -rf dc >& /dev/null"
        feedback_sit ""
     } elseif { $com == "compile" } {
        if ![file exist $dir/lib] { eval exec "/usr/bin/mkdir $dir/lib" }
        feedback_sit "Compiling Dc-Package, please wait"
        cd "$dir/star"
        eval exec "ln -s . include"
        cd $dir/dc
        eval exec "/usr/local/bin/gmake CC=gcc -f Makefile >& make.log"
        feedback_sit ""
     }
     cd $userdir
}

#### The Status of NQS query
proc StatusNQS { } {
     global font100 userdir

     feedback_sit "Running qstat, please wait a moment..."
     set qstat /usr/local/bin/qstat
     set fileq [file join $userdir qstat.csh]
     if [file exist $fileq] {eval exec "/bin/rm -f $fileq"}
     eval exec "touch $fileq"
     eval exec "echo #!/bin/csh -f >> $fileq"
     foreach I {1 2 3 4 5 6 7 9} {
          eval exec "echo $qstat -a -h axnd0$I >> $fileq"
     }
     set I 10; while {$I<35} {
          eval exec "echo $qstat -a -h axnd$I >> $fileq"
          incr I
     }
     eval exec "chmod a+x $fileq"
     Run $fileq $font100
     feedback_sit ""
}

#### The Send command to NQS query
proc SendtoNQS { } {
     global font100 userdir workdir
     set w .nqsmanager
     createWindow $w "NQS Manager"

     frame  $w.top.f1 -bd 2
     label  $w.top.f1.l1 -text "Input File:" -padx 0 -bg gray85
     entry  $w.top.f1.e1 -width 40 -relief sunken -bg gray85 \
                         -textvariable userdata
     bind   $w.top.f1.e1 <Return> {set data $userdata}
     focus  $w.top.f1.e1 
     button $w.top.f1.b1 -text Browse -bg gray80 -command {
            feedback_sit "Open input file"
            set userdata [tk_getOpenFile -initialdir $starfzdir]
            feedback_sit ""
           }
     pack   $w.top.f1.l1 -side left
     pack   $w.top.f1.b1 -side left
     pack   $w.top.f1.e1 -side right
 
     foreach i {f2 f3 f4 f5} {
       frame $w.top.$i -bd 2
       entry $w.top.$i.entry -relief sunken -width 40 -textvariable u$i
       label $w.top.$i.label
       pack  $w.top.$i.entry -side right
       pack  $w.top.$i.label -side left
     }
     $w.top.f2.label config -text "# of events to proceed:"
     $w.top.f3.label config -text "# of events to noise:"
     $w.top.f4.label config -text "# of events to pedestals:"
     $w.top.f5.label config -text "# of CPU time to run (sec):"

     message $w.top.msg -aspect 1000 -justify center -bg gray85 \
             -text "Please specify the variable below"
     frame $w.top.final -bd 2
     button $w.top.final.quit -text Quit -bg gray80 -command "destroy $w"
     button $w.top.final.ok -text Ok -bg gray80 -command {
            set user_e ""; set user_n ""; set user_p ""; set usertime 1000;
            if {$uf2 != 0 && $uf2 != ""} {set user_e "-e $uf2"}
            if {$uf3 != 0 && $uf3 != ""} {set user_n "-n $uf3"}
            if {$uf4 != 0 && $uf4 != ""} {set user_p "-p $uf4"}
            if {$uf5 != 0 && $uf5 != ""} {set usertime $uf5}
            set usertime 1000
            set userflags "-i $userdata $user_e $user_n $user_p"
            feedback_sit "Running qsub, please wait"
            set prog  [file join [file join $workdir star] OSF1]
            set prog  [file join $prog simaindev.exe]
            set fileq [file join $userdir job.nqs]
            if [file exist $fileq] {eval exec "/bin/rm -f $fileq"}
            eval exec "touch $fileq"
            set  str  {$prog $FLAGS >& job.out}
            if [catch {open $fileq w} fileId] {
                puts stdout "Cannot open file $fileq: $fileId"
            } else {
                puts $fileId "# NQS job"
                puts $fileId "# @$ -lt $usertime"
                puts $fileId "# @$ -me"
                puts $fileId "# @$"
                puts $fileId "setenv STARSRC $workdir/star"
                puts $fileId "setenv DATA    $userdata"
                puts $fileId "setenv FLAGS  '$userflags'"
                puts $fileId "setenv prog    $prog"
                puts $fileId "cd $userdir"
                puts $fileId "/bin/rm -rf job.out"
                puts $fileId $str
                puts $fileId exit
            }
            close $fileId
            eval exec "chmod a+x $fileq"
            cd $userdir
            if {$usertime < 1000} {
              eval exec "/usr/local/bin/qsub job.nqs"
            } else {
              eval exec "/usr/local/bin/qsub -q cpqL job.nqs"
            }
            feedback_sit ""
     }
     pack $w.top.msg -side top
     pack $w.top.f1 $w.top.f2 $w.top.f3 $w.top.f4 $w.top.f5 -side top -fill x
     pack $w.top.final.ok -ipadx 7 -padx 60 -side left
     pack $w.top.final.quit -padx 60 -side right
     pack $w.top.final -side top
}

#### The stagein command
proc StageTape { } {
     global font100 userdir workdir
     set w .stagemanager
     createWindow $w "Stage Manager"

     foreach i {f1 f2 f3} {
       frame $w.top.$i -bd 2
       entry $w.top.$i.entry -relief sunken -width 40 -textvariable u$i
       label $w.top.$i.label
       pack  $w.top.$i.entry -side right
       pack  $w.top.$i.label -side left
     }
     $w.top.f1.label config -text "Tape name:"
     $w.top.f2.label config -text "Data size:"
     $w.top.f3.label config -text "Link name:"

     message $w.top.msg -aspect 1000 -justify center -bg gray85 \
             -text "Please specify the variable below"
     frame $w.top.final -bd 2
     button $w.top.final.quit -text Quit -bg gray80 -command "destroy $w"
     button $w.top.final.ok -text Ok -bg gray80 -command {
            set stage "-V $uf1 -q 9 -l sl -F F -L 28800 \
                       -s $uf2 $uf3 &"
            feedback_sit "Running stagein, please wait"
            cd $userdir
            eval exec "/usr/local/bin/stagein $stage"
            feedback_sit ""
     }
     pack $w.top.msg -side top
     pack $w.top.f1 $w.top.f2 $w.top.f3 -side top -fill x
     pack $w.top.final.ok -ipadx 7 -padx 60 -side left
     pack $w.top.final.quit -padx 60 -side right
     pack $w.top.final -side top
}

#### Set environment variables
proc SetEnvironment { dir } {
     global env
     set env(STARSRC) $dir/star
     set env(USERSRCDIR) $dir
     set env(USERLIBDIR) $dir/lib
}

#### Run the program and arrange to read its input
proc Run { command {font $font100} } {
     global input font100 run_command
     set run_command $command
     if [catch {open "|$command |& cat"} input] {
        displayWindow $command $font100
     } else { 
             fileevent $input readable Log 
             displayWindow "" $font100
     }
}

#### Read and log output from the program to displayWindow
proc Log {} {
     global input log
     if [eof $input] {
         feedback_sit "Running"
         catch {close $input}
         feedback_sit ""
     } else {
         feedback_sit "Running"
         gets $input line
         $log insert end $line\n
         $log see end
#         $text_global insert end $line\n
#         $text_global see end
#         Text_Dump $log stdout
#         puts $line
         feedback_sit ""
     }
}

#### Printing environment variable values
proc printenv { args } {
     global env
     set maxl 0
     if {[llength $args] == 0} {
        set args [lsort [array names env]]
     }
     foreach x $args {
        if {[string length $x] > $maxl} {
           set maxl [string length $x]
        }
     }
     incr maxl 2
     foreach x $args {
        puts stdout [format "%*s = %s" $maxl $x $env($x)]
     }
}

proc feedback_sit { message } {
  #######################################################################    
  # This code is adapted from the text "Practical Programming in
  # Tcl and Tk", by Brent B. Welch (see page 440)
  #######################################################################    
  global feedback

  set e $feedback(sit)
  $e config -state normal
  $e delete 0 end
  $e insert 0 $message
  # Leave the entry in a read-only state
  $e config -state disabled

  # Force a disable update
  update idletasks
}

#### Mail program
proc MailManager { } {
     global stargraph starbatch file env workdir userdir t
     set w .mailmanager
     createWindow $w "Mail Manager"
     cd $userdir

     frame $w.top.t
     pack $w.top.t -side top -fill both -expand true
     message $w.top.t.m -aspect 500 -justify center \
                        -text "Print your bug and touch Send"
     pack $w.top.t.m -side top -fill x

     set t [text $w.top.t.t -setgrid true -wrap word -width 42 -height 14 \
            -yscrollcommand "$w.top.t.sy set"]
     scrollbar $w.top.t.sy -orient vert -command "$w.top.t yview"
     pack $w.top.t.sy -side right -fill y
     pack $w.top.t.t -side left -fill both -expand true
     
     button $w.top.quit -bg gray85 -text Quit -command "destroy $w"
     button $w.top.send -bg gray85 -text Send -command {
        if [file exists "$workdir/mail.bug"] {
            eval exec "/bin/rm -f $workdir/mail.bug" 
        } else {
            eval exec "touch $workdir/env.csh"
        }
        if [catch {open $workdir/mail.bug w} fileId] {
            puts stdout "Cannot open file $workdir/mail.bug: $fileId"
        } else {
            set d [exec date]
            puts $fileId $d
            puts $fileId " "
            Text_Dump $t $fileId
            close $fileId
        }
        eval exec "mail Valentin.Kouznetsov@cern.ch < mail.bug"
        eval exec "/bin/rm -f $workdir/mail.bug"
    }
    pack $w.top.quit -side right
    pack $w.top.send -side left
}

#######################################################################    
#### This code is adapted from the text "Practical Programming in
#### Tcl and Tk", by Brent B. Welch second edition(see page 384)
#### Author: Valentin E. Kuznetsov, NOMAD-STAR, Sep. 21, 1997
#######################################################################    
#### Dump of the text t to channel (may be stdout, stderr, fileId etc.)
proc Text_Dump {t channel {start 1.0} {end end}} {
    foreach {key value index} [$t dump $start $end] {
       if {$key == "text"} {
          puts $channel $value
       }
    }
}