#!/usr/bin/perl
#
# $Id: whatprog,v 1.2 1994/11/20 06:19:00 weingart Exp weingart $
#
# Whatnowproc for MH-6.8

# Get the command line arguments
push(@ARGV, split(' ', `mhparam whatnow`));

# Dispatch table
%dispatch = (
        'alias',        'alias_proc',
        'echo',         'echo_proc',
        'edit',         'edit_proc',
        'encrypt',      'encrypt_proc',
        'env',          'env_proc',
        'mime',         'mime_proc',
        'quit',         'quit_proc',
        'send',         'send_proc',
        'set',          'set_proc',
        'sign',         'sign_proc',
        'unalias',      'unalias_proc',
        'unset',        'unset_proc',
);

# Alias table
%aliases = (
);

# Variables table
%var = (
        'prompt',               '"Draft($message): "',
        'alias_level',  10,
);


# Mainline
{
        # Init variables
        foreach $key (keys %ENV){
                next if($key !~ m/^mh/);

                $var{$key} = $ENV{$key};
        }
        split(/\//, $ENV{'mhdraft'});
        $var{'message'} = pop(@_);

        # Read init file
        if(open(INIT, "$ENV{HOME}/.whatnowrc")){
                while(<INIT>){
                        &do_command($_);
                }
                close(INIT);
        }

        # Command loop
        &prompt;
        while(<>){
                # Execute command
                &do_command($_);

                &prompt;
        }
        exit(0);
}


# Handle command
sub do_command {
        local($cmd) = $_[0];
        local(@cmd);

        # Massage line into list
        chop($cmd);
        @cmd = &do_token($cmd);
        return if($#cmd == -1);

        # Interpolate vars
        @cmd = &do_vars(@cmd);

        # Do aliases
        @cmd = &do_aliases(@cmd);

        # Execute cmd
        if(defined($dispatch{$cmd[0]})){
                &{ $dispatch{$cmd[0]} }(@cmd);
                print "$@\n" if($@);
        }else{
                print "Not finished yet\n";
        }
}

# Do aliases
sub do_aliases {
        local(@args) = @_;
        local($deep) = 0;

        while(defined($aliases{$args[0]}) && ($deep != $var{'alias_level'})){
                $args[0] = $aliases{$args[0]} if(defined($aliases{$args[0]}));
                $deep++;

                print "Infinite recursion...\n" if($deep == $var{'alias_level'});
        }
        if($deep >= $var{'alias_level'}){
                &prompt;
                next;
        }

        return(@args);
}


# Print out prompt
sub prompt {
        local($message);
        local($prompt);

        split('/', $ENV{'mhdraft'});
        $message = pop(@_);

        if(defined($var{'prompt'})){
                $prompt = eval("$var{'prompt'}");
                print "$prompt";
        }else{
                print "Draft $message> ";
        }
        flush;
}


# Unalias an alias
sub unalias_proc {
        local(@args) = @_;
        local($cmd);

        $cmd = shift(@args);
        $cmd = shift(@args);

        if(!defined($aliases{$cmd})){
                if($cmd !~ m/^\s*$/){
                        print "Alias $cmd does not exist!\n";
                }else{
                        print "Huh, say what?\n";
                }
        }else{
                delete($aliases{$cmd});
        }
}


# Alias some command
sub alias_proc {
        local(@args) = @_;
        local($cmd, $exp, $tmp);

        $cmd = shift(args);
        $cmd = shift(args);
        $exp = join(' ', @args);

        if(defined($dispatch{$cmd})){
                print "Can not alias that!\n";
                return;
        }

        if($exp !~ m/^\s*$/){
                $aliases{$cmd} = $exp;
        }else{
                foreach $tmp (keys %aliases){
                        print "$tmp\t->\t$aliases{$tmp}\n";
                }
        }
}


# Echo arguments
sub echo_proc {
        local(@args) = @_;

        shift(@args);
        print join(' ', @args);
        print "\n";
}


# Set a variable
sub set_proc {
        local(@args) = @_;
        local($tmp);

        if($#args == 0){
                foreach $tmp (keys %var){
                        print "$tmp = $var{$tmp}\n";
                }
        }else{
                $var{$args[1]} = $args[3];
        }
}


# Unset a variable
sub unset_proc {
        local(@args) = @_;
        local($tmp);

        return if($#args != 1);

        $tmp = $args[1];
        delete $var{$tmp} if(defined($var{$tmp}));
}


# Interpolate variables
sub do_vars {
        local(@args) = @_;
        local($tmp);

        foreach $tmp (@args){
                next if($tmp !~ m/^\$([a-zA-Z]\w*)/);

                if(!defined($var{$1})){
                        print "\$$1 is not defined.\n";
                }else{
                        $tmp =~ s/\$(\w+)/$var{"$1"}/;
                }
        }

        return(@args);
}


# Encrypt a document
sub encrypt_proc {
        print "Hang on sloopy!\n";
        print @_;
}


# Sign a document
sub sign_proc {
        print "Hang on sloopy!\n";
        print @_;
}


# Mime a document
sub mime_proc {
        local($mimeproc);
        local(@mimeproc);

        chop($mimeproc = `mhparam buildmimeproc`);
        chop($mimeproc = `mhparam automhnproc`) if($mimeproc eq '');
        @mimeproc = split(/\s+/, $mimeproc);
        system(@mimeproc, "$ENV{'mhdraft'}");
}


# Send a document
sub send_proc {
        local($sendproc);
        local(@sendproc);
        local($domime);

        chop($domime = `mhparam automimeproc`);
        &mime_proc if($domime eq '1');
        chop($sendproc = `mhparam sendproc`);
        @sendproc = split(/\s+/, $sendproc);
        system(@sendproc, "$ENV{'mhdraft'}");
}


# Edit a document
sub edit_proc {
        system("$ENV{'mheditor'}", "$ENV{'mhdraft'}");
}


# Print environment
sub env_proc {
        local($i);

        foreach $i (keys %ENV){
                next if($i !~ m/^mh/i);
                print "$i => $ENV{$i}\n";
        }
}


# Quit this
sub quit_proc {
        local(@args);
        local($tmp);

        $tmp = join(' ', @_);
        @args = split(/\s+/, $tmp);

        if(!grep(/^-nodel(ete)?/, @args)){
                $tmp = $ENV{'mhdraft'};
                $tmp =~ s|/(\d+)$|/,$1|;
                rename($ENV{'mhdraft'}, $tmp);
        }

        exit(0);
}


# Tokenize line
sub do_token {
        local($line) = $_[0];
        local(@match) = ();
        local(@what) = ();
        local($i, $tmp);


        for($i = 0; $line ne ''; $i++){

                # BLANK
                if($line =~ m/^(\s+)/){
                        $line = substr($line, length($1));
                }

                # WORD
                if($line =~ m/^(\w+)/){
                        $what[$i] = 'WORD';
                        $match[$i] = $1;
                        $line = substr($line, length($1));
                        next;
                }

                # VAR
                if($line =~ m/^(\$[a-zA-Z]\w*)/){
                        $what[$i] = 'VAR';
                        $match[$i] = $1;
                        $line = substr($line, length($1));
                        next;
                }

                # STRING
                if($line =~ m/^("[^"]*")/){
                        $what[$i] = 'STRING';
                        $match[$i] = $1;
                        $line = substr($line , length($1));
                        next;
                }

                # SPECIAL
                if($line =~ m/^([=])/){
                        $what[$i] = 'SPECIAL';
                        $match[$i] = $1;
                        $line = substr($line, length($1));
                        next;
                }

                # Comment
                if($line =~ m/^(#.*)/){
                        $line = substr($line, length($1));
                        next;
                }

                # ERROR
                if($line =~ m/^(.+)$/){
                        print "Found ERROR($1).\n";
                        $line = substr($line, length($1));
                        next;
                }

        }

        return(@match);
}