#!/usr/local/bin/wish
# (Function)
#    Tkremexec executes a unix command on a remote host which is
#    selectable from a tk-based interface.
# (Update Record)
#    95/10/06  K.Fujii		Original version.
#    95/10/29  K.Fujii		Modified to use argv.
#    95/11/19  K.Fujii		Modified to allow users to change
#				the list of systems through Xresources
#
#   tkremexec.f0.rbbox.uxlist:	jlcux1 jlcux2 jlcux3 jlcuxm jlcsv1e tophp1
#
#
#
#--
#  Set preferences.
#--
set biglabelfont "helvbo14"
set labelfont "helvb12"
set messagefont "helvb12"
set helpfont "fixed"
set itemfont "fixed"
#
proc split_rgb {name} {
	set rgblength [string length $name]
	case $rgblength {
	    4 {set format "#%1x%1x%1x"; set shift 12}
	    7 {set format "#%2x%2x%2x"; set shift 8}
	    10 {set format "#%3x%3x%3x"; set shift 4}
	    13 {set format "#%4x%4x%4x"; set shift 0}
	    default {error "syntax error in color name \"$name\""}
	}
	if {[scan $name $format red green blue] != 3} {
	    error "syntax error in color name \"$name\""
	}
	set red [expr $red<<$shift]
	set green [expr $green<<$shift]
	set blue [expr $blue<<$shift]
	return "$rgblength $red $green $blue"
}

proc darken_color {color scale} {
   set rgblist [split_rgb $color]
   set rgblength [lindex $rgblist 0]
   set red   [format %.0f [expr $scale*[lindex $rgblist 1]]]
   set green [format %.0f [expr $scale*[lindex $rgblist 2]]]
   set blue  [format %.0f [expr $scale*[lindex $rgblist 3]]]
   case $rgblength {
	    4 {set format "#%01x%01x%01x"}
	    7 {set format "#%02x%02x%02x"}
	    10 {set format "#%03x%03x%03x"}
	    13 {set format "#%04x%04x%04x"}
	    default {error "syntax error in color name \"$name\""}
   }
   set new_color [format "$format" $red $green $blue]
   return $new_color
}

set how_dark 0.875
set vuecolors [exec getvuecolor]
set bg1color [lindex $vuecolors 2]
set bg2color [darken_color [lindex $vuecolors 2] $how_dark]
set bg3color [lindex $vuecolors 7]
set bg4color [lindex $vuecolors 4]

set fwdcolor "white"
set fwacolor $fwdcolor
set fw2color "yellow"
set fw3color "yellow"

set txfcolor $fwdcolor
set txbcolor $bg2color
set sbfcolor $bg1color
set sbbcolor $bg2color
set sbacolor $bg1color
#--
#  Define message dialog proc.
#--
proc help_dialog {fh msg} {
   global messagefont helpfont
   message $fh.msg -text $msg -font $helpfont -aspect 600
   button $fh.ok -text OK -command { set val 0 } -font $messagefont
   pack $fh.msg $fh.ok -side top
   tkwait variable val
   destroy .
}
#--
#  Set DIROPT and COMMAND.
#--
if { $argc == 0 || $argc > 2 } {
   help_dialog "" " Tkremexec xecutes \<commands\> on a remote host. \n\
   Syntax: \n\
   \t  tkremexec \[-dir\|nodir\] \"\<commands\>\""
   exit 0
} elseif { $argc == 1 } {
   set diropt "nodir"
   set command [lindex $argv 0]
} elseif { $argc == 2 } {
   set diropt  [string trimleft [lindex $argv 0] -]
   set command [lindex $argv 1]
}
#--
#  Set default machine.
#--
set machine $env(HOST)
set mymachine "jlcuxm"
catch { set mymachine $env(MYOWNWS) }
set default_uxlist "jlcux1 jlcux2 jlcux3 $mymachine jlcsv1e"
wm title . "[exec basename $command]"
#--
#  Set frames.
#--
frame .f0 -bd 4 -bg $bg1color
frame .f0.lbbox -bd 2 -relief groove -bg $bg4color
frame .f0.rbbox -bd 2 -relief sunken -bg $bg2color
frame .f0.swbox -bd 2 -relief flat -bg $bg1color
#--
#  Set header label.
#--
label .f0.lbbox.label -text "Make Your Choice" -font $biglabelfont \
	-background $bg4color -height 2
pack .f0.lbbox.label -side top -fill both
#--
#  Set up switch box.
#--
set frb .f0.rbbox
set uxlist [option get $frb uxlist {}]
if { $uxlist == "" } {
   set uxlist $default_uxlist
}
foreach ux $uxlist {
   radiobutton .f0.rbbox.$ux \
	-text [format "  %-8s"  $ux] -value $ux -variable machine \
	-font $itemfont -relief flat \
	-highlightthickness 0 \
	-activeforeground $fwacolor \
	-activebackground $bg2color \
	-background $bg2color \
	-height 1 -width 14
   pack .f0.rbbox.$ux -side top -fill both -anchor w
}
#--
#  Set up button.
#--
button .f0.swbox.cancel -text "Quit" \
	-command { exit 0 } -font $labelfont \
	-highlightthickness 0 \
	-foreground $fw3color \
	-activeforeground $fw3color \
	-width 7
button .f0.swbox.ok -text "OK" \
	-command { exec_command $machine } -font $labelfont \
	-highlightthickness 0 \
	-activeforeground $fwacolor \
	-width 7
pack .f0.swbox.cancel .f0.swbox.ok -padx 0 -anchor w -fill both -side left
#--
#  Pack everything.
#--
pack .f0.lbbox .f0.rbbox .f0.swbox -fill both -anchor w -side top
pack .f0

wm minsize . 1 1

#--
#  Fill the listbox with a list of all the files in the directory (run
#  the "ls" command to get that information).
#--
proc exec_command {machine} {
   global env diropt command
   if { $machine == $env(HOST) } {
      exec $command &
   } else {
      switch $diropt {
         dir     { exec remexec       $machine "$command" & }
         nodir   { exec remexec_nodir $machine "$command" & }
         default { exec remexec_nodir $machine "$command" & }
      }
   }
}