#!/usr/athena/bin/perl -- -*-perl-*-
#From: rwk@crl.dec.com (Bob Kerns)

# some magic to get perl loaded even if we're not in 
eval '(exit $?0)' && eval 'exec /udir/rwk/perl/perl-4.010/perl -S $0 ${1+"$@"}'
& eval 'exec /udir/rwk/perl/perl-4.010/perl -S $0 $argv:q'
       if 0;
require 'line_edit.pl';

$read_eval_print_version = "RWK Read-eval-print version 1.0.  12 Sep 1991.";

$_=$];
($major_version, $minor_version, $patch_level) =
  /\$\$Revision:\s*(\d+)\.(\d+)\./;

($patch_level) = /Patch level:\s*(\d+)/;

($build_date) = /\$Date:\s*(.+)\s*\$/;

# Empty out the search stuff so when the user turns on searching he's not
# surprised.

$_="";
//;

print "This is perl, version $major_version.$minor_version.$patch_level.
Date: $build_date

Copyright (c) 1989, 1990, 1991, Larry Wall

Perl may be copied only under the terms of either the Artistic License or the
GNU General Public License, which may be found in the Perl 4.0 source kit.

$read_eval_print_version

Type '?' for help.
";

$help_text = "\n-- perl read-eval-print loop --

Entry:

  To see the value of an expression, enter it on a single line.

  To enter multiple line expressions, first enter a line with just the '#' character.
  Finish your input with another line containing just the '#' character.

  If you begin the line with a label, a statement, or a subroutine definition,
  it will automatically enter multi-line mode for you.

Context:

  You can operate in either array or scalar context.

  To enter scalar context, enter a line with just a '$'.

  To enter array context, enter a line with just a '@'.

  To help you catch the surprises of unexpected results in array context,
  the default is array context.

Prompting:

  To help you keep track of what context you're in, the prompt will include
  either the @ or the $ character.

  In multi-line mode, the prompt includes the # character, to remind you
  to enter that to indicate that your multi-line input is complete.

Results:

  The results are printed for any expressions evaluated.  In array context,
  each value is printed on a separate line.

Searching:

  In Search mode, the search variables are displayed after each expression.
  This allows easy testing of different search patterns.  Only the non-null
  values are displayed.

  To enter or exit search mode, type '/' on a single line.

Shell commands:
  You may type shell commands by prefixing them with '#!'.

Help:

  Type '?' on a line to get this help message.
";

$search=0;	# Set to true for displaying search context information.
$scalar=0;	# Set to true to use scalar context instead of array context.
$multi=0;	# Set to true to evaluate multi-line entries.
$statement=0;	# Set to true if we're doing a statement, not an expression.
$prompt="> ";	# Basic prompt.

# Check for one of our single-character commands.
sub eval_print
{
  local ($search, $scalar) = (0, 0);
  while(1) {
    READ_EVAL_PRINT: {
      local ($multi, $statement, $label, $line, $command, $shell) = (0, 0, "", "", "");
      # If we're here, we're not yet in statement or multi mode, make sure these
      # are cleared.
      $statement=0; $multi=0;
      $promptx = ($scalar ? "\$" : "\@");

#     print($promptx,$prompt);
#     $line=<>;
 
      # here we insert the new and improved command-line editing
      # version of getline
      $line = &line_edit'get("$promptx$prompt");
      # No chopping required
#     chop($line);
      # Process single-character commands.
      if (($command)=($line =~ /^\s*([^ 0-9])\s*$/)) {
	if ($command eq '@') {
	  $scalar=0;
	  next READ_EVAL_PRINT;
	} elsif ($command eq '$') {
	  $scalar=1;
	  next READ_EVAL_PRINT;
	} elsif ($command eq '/') {
	  $search=!$search;
	  if ($search) {
	    print "Printing search variables after each expression; type '/' to disable.\n";
	    &print_search(@locals);
	  }
	  next READ_EVAL_PRINT;
	} elsif ($command eq '?') {
	  print $help_text;
	  next READ_EVAL_PRINT;
	} elsif ($command eq '#') {
	  $multi=1;
	  $line="";
	} else {
	  print "Unrecognized $command; type ? for help.\n";
	}
      }
      if (($shell) = ($line =~ /^#!\s*(.*)$/)) {
	if (system($shell)) {
	  if ($!) {
	    print("$!\n");
	  }
	}
	next READ_EVAL_PRINT;
      }
      if (($label)=($line =~ /^\s*([A-Za-z_]\w*)\s*:/)) {
        # Label: begins multiline, with Label:> prompt.
	$label = (($label == 1) ? "" : $label) . ":";
	$multi=$statement=1;
      }
      # Check for it starting with one of the simple statements.
      if ($line =~ /^\s*((if|else|elseif|while|for|foreach|unless|sub)\b|\{)/ ) {
	$statement=1;
	# Semi-colon at end, with only whitespace or comment,
	# is not start of multiple-line entry.
	$multi = !($line =~ /;\s*(#.*)*$/);
      }
      if ($multi) {
	local ($mline);
        READ_MULTI: while ($multi) {
	  print "#",$label,$prompt;
	  $mline=<>;
	  if ($mline =~ /^\s*#\s*$/ ) {
	    last READ_MULTI;
	  }
	  $line = $line . "\n" . $mline;
	}
	{ # Check to see if it was a statement, after all.
	    local ($*) = (1);
	    if ($line =~ /^\s*((if|else|elseif|while|for|foreach|unless|sub)\b|\{)/ ) {
	      $multi=$statement=1;
	    }
	  }
      }
      { local ($*) = (1);
        # Look for any lines with something besides comments.
	if ( !($line =~ /^\s*[^ #	\n].*$/ )) {
	  $line = "";
	}
      }

      # Do the eval_print iff we got any input., if we got a
      if ($line) {
	$valspec=($statement ? '' : ( ($scalar ? '$val' : '@val') . '='));
	eval("(\$1,\$2,\$3,\$4,\$5,\$6,\$7,\$8,\$9,\$\&,\$\`,\$\',\$\+)=\@locals;
              $valspec$line;
              \@locals=(\$1,\$2,\$3,\$4,\$5,\$6,\$7,\$8,\$9,\$\&,\$\`,\$\',\$\+)");
	if ($statement) {
	  print("<statement; no value>");
	} else {
	  local($,) = ("\n");
	  print(($@||($scalar ? $val :  @val)));
	}
        print("\n");
	if ($search) {
	  &print_search(@locals);
        }
      }
    }
  }
}

sub print_search {
  local($,) = ("\n");
  ($1, $2, $3, $4, $5, $6, $7, $8, $9, $`, $', $+) = @_;
  print("--Search--",
	"\$_:$_",
	($1 ? "\$1:$1" : ()),
	($2 ? "\$2:$2" : ()),
	($3 ? "\$3:$3" : ()),
	($4 ? "\$4:$4" : ()),
	($5 ? "\$5:$5" : ()),
	($6 ? "\$6:$6" : ()),
	($7 ? "\$7:$7" : ()),
	($8 ? "\$8:$8" : ()),
	($9 ? "\$9:$9" : ()),
	($& ? "\$&:$&" : ()),
	($` ? "\$\`:$`" : ()),
	($' ? "\$\':$'" : ()),
	($+ ? "\$+:$+" : ()),
        ($* ? "\$*:$*" : ()),
        "");
}

## Now *DO* it!

&eval_print();