#!/usr/bin/wish
#
# Second attempt at GUI to run Sib-pair interactively
#
# Procedure to list contents of directory
#
proc lister { dir list } {
     $list delete 0 end
     $list insert end ".."
     foreach j [exec ls $dir] {
        $list insert end $j
     }
}
#
# Procedure to read file into widget
#
proc readf { file widget } {
    set f [open $file r]
    $widget insert end [ read $f ]
    close $f
}
#
# Procedure to read file into widget
#
proc get_file { widget prog_name process} {
    set infil [ tk_getOpenFile ]
    set f [open $infil r]
    $widget insert end "#\n# Read from $infil\n#\n"
    $widget insert end [ read $f ]
    close $f
    set dir [ string range $infil 0 [ string last / $infil ] ]
    set newdir "pwd "
    append newdir $dir
    if {($prog_name == "sib-pair")} {
      puts $::process $newdir
      flush $process
    }
    .top.pwd.thisdir delete 0 end
    .top.pwd.thisdir insert end $dir
    lister $dir .files.list
}
#
# Procedure to save contents of widget to file
#
proc save { output access } {
    if {($access == "a") && ![file isfile "sib-pair.log"]} {
      set f [open "sib-pair.log" w]
    } else { 
      set f [open "sib-pair.log" $access]
    }
    puts $f [ $output get 1.0 end ] 
    close $f
}
#
# Help text
#
proc help.text {} {
    option add *Dialog.msg.font {Times 12}
    tk_messageBox -title "Help" -message \
"ISP: GUI front end for Sib-pair
Author: David Duffy
Last Updated: 2008-03-26

Double click on text to be sent to program" \
                  -type ok

}
#
# Main declarations 
#
set input_font {Helvetica 14 }
set output_font {Courier 14 bold}

set dir [pwd]
set preface "\"set echo on\n\""
set prog_name sib-pair
set prog_title Sib-pair

global process
set process [open "| $prog_name" r+]
wm title . "$prog_title GUI"
wm iconname . $prog_title

#
# Top bar
#
frame .top
#
# The button bar 
#
frame .top.buttons
button .top.buttons.help -text "Help" -command "help.text" 
button .top.buttons.inc -text "Include Text" \
                        -command "get_file .input.text $prog_name $process"
button .top.buttons.iclear -text "Clear Input" -command ".input.text delete 1.0 end"
button .top.buttons.save_out -text "Save Output" -command "save .output.text w"
button .top.buttons.append_out -text "Append Output" -command "save .output.text a"
button .top.buttons.clear_out -text "Clear Output" -command ".output.text delete 1.0 end"
button .top.buttons.dismiss -text "Quit" -command "exit"
pack .top.buttons.help .top.buttons.inc .top.buttons.iclear \
     .top.buttons.save_out .top.buttons.append_out .top.buttons.clear_out \
     .top.buttons.dismiss \
     -side left -expand yes -fill x -padx 2m
#
# Directory window
#
frame .top.pwd
label .top.pwd.pwd -text "PWD:"
entry .top.pwd.thisdir -relief sunken -width 35
pack .top.pwd.pwd -side left -expand no -fill both
pack .top.pwd.thisdir -side left -expand yes -fill both

#
# Directory contents window
#
frame .files
scrollbar .files.scroll -command ".files.list yview"
pack .files.scroll -side right -fill y
listbox .files.list -yscroll ".files.scroll set" -relief sunken \
        -height 15 -setgrid yes
pack .files.list -side left -fill both -expand yes
#
# Menu       
#
# menu .menuBar -tearoff 0
#  .menuBar add command -label "Help" \
#        -command "puts $prog_name"  -underline 1  
# .menuBar add command -label "Clear Input" \
#        -command ".input.text delete 1.0 end" -underline 0  
# .menuBar add command -label "Save Output" \
#        -command "save .output.text w" -underline 0  
# .menuBar add command -label "Append Output" \
#        -command "save .output.text a" -underline 0  
# .menuBar add command -label "Clear Output" \
#        -command ".output.text delete 1.0 end" -underline 6  
# .menuBar add command -label "Quit" -command "exit" -underline 0  

#
# Two text windows and corresponding scrollbars
#
frame .input
text .input.text -relief sunken -bd 2 -yscrollcommand ".input.scroll set" \
     -font $input_font -setgrid 1 -height 5
label .input.label -text "Input Window" -height 1 -relief raised
scrollbar .input.scroll -command ".input.text yview" 

frame .output
text .output.text -relief sunken -bd 2 -yscrollcommand ".output.yscroll set" \
     -xscrollcommand ".output.xscroll set" \
     -wrap none -font $output_font -setgrid 1 -height 10
label .output.label -text "Output Window" -height 1 -relief raised
scrollbar .output.yscroll -orient vertical -command ".output.text yview"
scrollbar .output.xscroll -orient horiz -command ".output.text xview"
#
# Arrangement
#
# . configure -menu .menuBar

pack .top.pwd .top.buttons -side left -fill both -expand yes
pack .top -fill both -side top

pack .files -side left -fill y

pack .input.label -fill x
pack .input.scroll -side right -fill y 
pack .input.text -expand yes -fill both 
pack .input -fill both -expand y -pady 1m

pack .output.label -fill x
pack .output.yscroll -side right -fill y  -expand no 
pack .output.xscroll -side bottom -fill x  -expand no 
pack .output.text  -expand yes -fill both 
pack .output -fill both -expand y -pady 1m


#
# Binding to read directory window directory or file selection
#
bind .files.list <Double-Button-1> {
     foreach i [selection get] { 
       set curfile "$dir/$i"
       set curfile [string trim $curfile *@]
       if [ file isdir $curfile ] {
         cd $curfile
         set dir [pwd]
         set newdir "pwd "
         append newdir $dir
         if {($prog_name == "sib-pair")} {
           puts $::process $newdir
           flush $process
         }
         .top.pwd.thisdir delete 0 end
         .top.pwd.thisdir insert end $dir
         lister $dir .files.list
       } elseif [ file executable $curfile ] {
           close $process
           set prog_name $curfile
           set prog_title $curfile 
           set process [open "| $curfile" r+]
       } else {
         readf $curfile .input.text 
       }
     } 
}
#
# Binding to submit line to program
#
bind .input.text <Double-Button-1> {
    puts $::process [ .input.text get 1.0 end ] 
    flush $process
    .input.text delete 1.0 end 
}
#
# List files and place cursor in input window
#
.top.pwd.thisdir insert end $dir   
lister $dir .files.list 
#
# IO from target program
#
fconfigure $process -blocking FALSE
#
# Procedure to interactively read response of binary to output window 
# 
fileevent $process readable {
#   gets $::process res
    .output.text insert end "\n\n"
    .output.text insert end [read $::process]  "\n"
    if { [eof $process] } { close $process; set forever 1 }
}
vwait forever