# package, meant to be do'ed, not run directly
#
# $Id: menu.pl,v 1.3 90/08/27 04:15:05 marc Exp Locker: marc $
#

package menu;

$gencmds = <<EOC;
help, ?:	__internal	Print the list of commands in this menu
exit:		__internal	Exit the current menu
quit:		__internal	Quit
EOC
    ;

sub sigint {
    die "Throw!\n";
}

# in a compiled table, there are entries as follows:
#
# {fundamental, alias} = fundamental
# {abbrev} = fundmental, alias, or ", " separated list if ambiguous.
# {fundamental}:alias = fundamental and aliases (string)
# {fundamental}:fct = fct name
# {fundamental}:help = help string
# : = ordered list of fundamentals (for help)
#

sub compile {
    local($cmds, $fct, $help, %menu, %prim);
    
    for (split(/\n/,$_[0]), split(/\n/,$gencmds)) {
	next if /^#/;
	if (/^\s*([^,:]+)([^:]*):\s+(\S+)\s+/) {
	    ($fund, $aliases, $fct, $help) = ($1, $2, $3, $');
	    
	    $aliases =~ s/,\s*/, /;
	    
	    $menu{"$fund:fct"} = $fct;
	    $menu{"$fund:help"} = $help;
	    $menu{"$fund:alias"} = $fund.$aliases;
	    
	    $menu{":"} .= $fund.' ';
	    
	    for $ali ($fund, split(/, /,$aliases)) {
		$a = $ali;
		next if !$a;
		
		$menu{$a} = $fund;
		chop $a;
		
		while($a) {
		    next if $prim{$a};
		    next if $menu{$a} =~ /(^| )$ali($|,)/;
		    
		    $menu{$a} .= ", " if $menu{$a};
		    $menu{$a} .= $ali;
		} continue {
		    chop $a;
		}
	    }
	    
	    $prim{$fund}++;
	}
    }
    key: for (keys(%menu)) {
	if (!/:/) {
	    ($fund, @ali) = split(/, /,$menu{$_});
	    for $a (@ali) {
		next key if ($menu{$a} ne $fund);
	    }
	    $menu{$_} =~ s/^([^,]+),.*$/$1/;
	}
    }

    return(%menu);
}

sub parse {
    local(*menu) = @_;
    
    while(($k,$v) = each(%menu)) {
	if ($k =~ /^:$/) {
	    print "Fundamentals are \"$v\"\n";
	} elsif ($k =~ /:alias$/) {
	    print "$` aliases are \"$v\"\n";
	} elsif ($k =~ /:fct$/) {
	    print "$` runs &$v()\n";
	} elsif ($k =~ /:help$/) {
	    print "$` does: \"$v\"\n";
	} else {
	    print "$k is an abbrev for \"$v\"\n";
	}
    }
}

sub do { # @_ = ($prompt, *cmds)
    local($prompt, *menu) = @_;
    local($oldsigint, $fund, $fct);
    
    $prompt = shift(@_);
    
    while (1) {
	print "\n$prompt: ";
	$oldsigint = $main'SIG{'INT'};
	$main'SIG{'INT'} = "menu'sigint";

	eval <<'EOE';
	    if (!($_ = <>)) {
		print "menu: eof on input.  Aborting...\n";
		exit(2);
	    }
	chop;
EOE
    ;

	if ($@ && $@ ne "Throw!\n") { die $@; }
	    
	$main'SIG{'INT'} = $oldsigint;

	if ($@ && $@ eq "Throw!\n") { print "\n"; return; }
	
	# strip leading whitespace, get cmd, arg.
	/^\s*(\S+)\s*/ || next;
	($cmd,$arg) = ($1,$');
	# strip trailing whitespace
	$arg =~ s/\s*$//;
	
	if (! defined($fund = $menu{$cmd})) {
	    print "\"$cmd\" is not a valid command.  Type ? for help.\n";
	    next;
	}

	if ($fund =~ /,/) {
	    print "Ambiguous. Could be one of: ",$fund,"\n";
	    next;
	}

	$fund = $menu{$fund};

	$fct = $menu{"$fund:fct"};
	
	if ($fct eq "__internal") {
	    if ($fund eq "help") {
		if ($arg) {
		    if ($_ = $menu{"$arg:help"}) {
			print $_,"\n";
		    } else {
			print "There is no command \"$cmd\"\n";
		    }
		    print $menu{"$arg:help"},"\n";
		} else {
		    foreach (split(' ',$menu{":"})) {
			printf ("%-15s\t%s\n",$menu{"$_:alias"},
				$menu{"$_:help"});
		    }
		}
	    } elsif ($fund eq "exit") {
		return;
	    } elsif ($fund eq "quit") {
		exit(0);
	    } else {
		die "Bogon __internal $_!\n";
	    }
	} else {
	    if ($fct !~ /\'/) {
		$fct = "main'".$fct;
	    }
	    
	    # exception handling!
	    
	    $oldsigint = $main'SIG{'INT'};
	    $main'SIG{'INT'} = "menu'sigint";
	    
	    eval("&$fct(\$arg, \$full);");
	    if ($@ && $@ ne "Throw!\n") { die $@; }
	    
	    $main'SIG{'INT'} = $oldsigint;
	}
    }
}