#!/usr/bin/perl
#####################################################################
# An example of calling "wish" as co-process subshell under Perl.
#
# The script is directly based on Gustaf Neumann's perlwafe script.
#
# Dov Grobgeld dov@menora.weizmann.ac.il
# 1993-05-17
#
# NOTE: The Perl::Tk module is a better solution.
# As such perl scripts do not need to use "wish" as a co-process.
#
#####################################################################

$wishbin = "/usr/bin/wish";

die "socketpair unsuccessful: $!!\n"
   unless socketpair(W0, WISH, 1, 1, 0);
if ($pid=fork) {
    select(WISH); $| = 1;
    select(STDOUT);

    # Create some TCL procedures
    print WISH 'proc echo {s} {puts stdout $s; flush stdout}',"\n";

} elsif (defined $pid) {
    open(STDOUT, ">&W0");
    open(STDIN, ">&W0");
    close(W0);
    select(STDOUT); $| = 1;
    exec "$wishbin --";
} else {
    die "fork error: $!\n";
}

# Remove the indent of a here file...
# And strip any # comments found in the here file
sub herefile {
  my $string = shift;
  $string =~ s/^\s+#.*\n//gm;  # completely remove full line comments
  $string =~ s/^\s+\| ?//gm;   # remove the indent part of the line
  $string =~ s/\s+$/\n/g;      # remove any extra end-of-line spaces
  return $string;
}

# Create the widgets so that they print the user selections
print WISH herefile (q*
  | # This is a comment "inside" wish
  |
  | frame .f -relief raised -border 1 -bg green
  | pack append . .f {top fill expand}
  |
  | button .f.button-pressme -text "Press me" -command {
  |     echo "That's nice."
  | }
  | button .f.button-quit -text quit -command {
  |     echo "quit"
  | }
  | pack append .f .f.button-pressme {top fill expand} \\
  |               .f.button-quit {top expand}
  *);

# Here is the main loop which receives and sends commands
# to wish.
while (<WISH>) {
    chop;
    print "Wish sais: <$_>\n";
    if (/^quit/) {
      print WISH "destroy .\n";
      last;
    }
}
wait;