root/trunk/Dish/dish

#!/usr/bin/perl -w
#
#       $rcs = ' $Id: dish,v 1.1 2001/01/24 03:34:06 wombat Exp $ ' ;   
#
# Copyright (c) 2000 Dan Cardamore  <wombat@hld.ca>
#
# This program is free software released under the GNU GPL.
#


package Dish;
use strict;
use Term::ReadLine;     # this is the Gnu one written by Hiroo Hayashi
use Curses;
use Curses::Widgets qw( :all );


use vars qw/$term $readconfig $HISTORY @path $login $window/;
$login = getpwuid($<);

##################
###  Start of TEMPORARY defines
$HISTORY = $ENV{'HOME'} . "/.dish_history";
@path = split /:/, $ENV{'PATH'};
###
#################

sub Version()
{
        print "Dish version 0.1\n";
        print "Uses: Curses, Curses::Widgets, Term::ReadLine::Gnu\n";
        print "Using Term::ReadLine: " . $term->ReadLine . "\n";
}

sub initCurses()
{
        $window = Curses->new or die "Can't get new Curses window\n";
}

sub exitCurses()
{
        endwin();
}

sub mainWindow()
{
        #       $window->erase();
        # This function selects a few common colours for the foreground colour
}

# This routine initializes the terminal for readline and curses
sub init()
{
        $term = new Term::ReadLine 'dish';
        $readconfig = $term->Attribs;

        $term->stifle_history(1000);  # limit history to 1000 lines
        $term->MinLine(undef);        # don't automatically add lines to history

        if ( -f $HISTORY)
        {
                        $term->ReadHistory($HISTORY) or print "No history\n";
        }
        else { system("touch $HISTORY"); }  # create the history file

        #  Now setup some key bindings
        $readconfig->{attempted_completion_function} = \&keywordCompletion;
        $readconfig->{completion_display_matches_hook} = \&displayMatchList;

        $SIG{INT} = sub {
                        $term->modifying;
                        $term->delete_text;
                        $readconfig->{point} = $readconfig->{end} = 0;
                        $term->redisplay;
        };
        return;
}

# determines if this is a perl or system keyword
sub keywordCompletion($$$$)
{
        my ($text, $line, $start, $end) = @_;
        my $perlflag = 0;
        if ($perlflag == 1)
        {
                return &perlCompletion($text,$line,$start,$end);
        }
        else
        {
                return &systemCompletion($text,$line,$start,$end);
        }
}

sub systemCompletion($$$$)
{
        my ($text, $line, $start, $end) = @_;
        my @matches = getSystemFunctionMatches($text);

        if (substr($line, 0, $start) =~ /^\s*$/) {
                $readconfig->{completion_word} = \@matches;
                undef $readconfig->{completion_display_matches_hook};
                return $term->completion_matches($text,
                                                                                                                                                 $readconfig->{'list_completion_function'});
        }
        elsif ($line =~ /^\s*(\.\/)\s/)
        {
                $readconfig->{completion_display_matches_hook} = \&systemFilenameDisplayMatches;
                return $term->completion_matches($text,
                                                                                                                                                 \&systemFilenameCompletion);
        }

        else {                  # put mput lcd
                undef $readconfig->{completion_display_matches_hook};
                return ();              # local file name completion
        }

#       $readconfig->{completion_append_character} = '';
#       return $term->completion_matches($text, \&systemSearchPath);
}

sub systemFilenameDisplayMatches()
{
        my($matches, $num_matches, $max_length) = @_;
        map { $_ =~ s|.*/([^/])|$1|; }(@{$matches});
        $term->display_match_list($matches);
        $term->forced_update_display;
}

sub systemSearchPathFunction()
{
        my ($text, $state) = @_;
        my $i;
        my @matches;
        
        if ($state)
        {
                $i++;
        }
        else
        {
                $i = 0;
                @matches = "?";

                foreach my $dir ( (".", @path) )
                {
                        opendir (DIR, $dir);
                        my @files = readdir(DIR);
                        closedir (DIR);

                        @files = grep(/^$text/, @files);
                        if ($#files > 0)
                        {
                                # remove . and ..
                                @files = grep (!/^\.\.?$/, @files);
                        }
                        push @matches, @files;
                }
        }

        my $entry;
        my $most = $text;  # this will be used to complete as much as possible but not more

        for (; $i <= $#matches; $i++)
        {
                print "i = $i\n";
                $entry = $matches[$i];
                return $entry if ($entry =~ /^\Q$text/);
        }
        return undef;
}

sub getSystemFunctionMatches()
{
        my ($text, $state) = @_;
        my $i;
        my @matches;

        $i = 0;
        @matches = "?";

        foreach my $dir ( (".", @path) )
        {
                opendir (DIR, $dir);
                my @files = readdir(DIR);
                closedir (DIR);

                @files = grep(/^$text/, @files);
                if ($#files > 0)
                {
                        # remove . and ..
                        @files = grep (!/^\.\.?$/, @files);
                }
                push @matches, @files;
        }
        @matches = sort @matches;
        return @matches;
}


sub perlCompletion($$$$)
{
        my ($text, $line, $start, $end) = @_;

#       if (substr($line, 0, $start) =~ m/\$([\w:]+)\s*(->)?\s*{\s*['"]?$/) {
#               # $foo{key, $foo->{key
#               $readconfig->{completion_append_character} = '}';
#               return $term->completion_matches($text, \&perl_hash_key_completion_function);
#       }
#       elsif (substr($line, 0, $start) =~ m/\$([\w:]+)\s*->\s*['"]?$/) {
#               # $foo->method
#               $readconfig->{completion_append_character} = ' ';
#               return $term->completion_matches($text, \&perl_method_completion_function);
#       }
#       else { # Perl symbol completion
#               $readconfig->{completion_append_character} = '';
#               return  $term->completion_matches($text, \&perl_symbol_completion_function);
#       }
}

sub displayMatchList($$$$)
{
    my ($text, $line, $start, $end) = @_;

}

sub quit()
{
    $term->WriteHistory($HISTORY);


    print "\n";
    exit(0);                     # clean exit
}


sub prompt()
{
    my $host = $ENV{'HOSTNAME'};
    my $dir = $ENV{PWD};
    $dir =~ s/^$ENV{'HOME'}/~/;
#    my $prompt = "[$login\@$host $dir]\$ ";   $dir doesn't refresh
    my $prompt = "[$login\@$host]-> ";

    return $prompt;
}

sub executePerl()
{

}

sub executeSystem($)
{
        my ($command) = @_;

        if ($command =~ /^\s*cd/)
        {
                $command =~ s/^\s*cd\s*//;
                chdir($command);
                return;
        }
        elsif ($command =~ /^\s*version/)
        {
                Version();
                return;
        }
        elsif ($command =~ /\&\s*$/)
        {
                # this one needs to be backgrounded
                
        }
  else
        {
                        system($command);
        }
        return;
}

sub getline()
{
        my ($line, $command);
        $command = '';
        while (1)
        {
                $line = $term->readline($command ? '> ' : prompt());
                return undef unless (defined $line);

                if ($line =~ /\\$/) # testing if this is multi line
                {
                        chop $line;       # remove newline char
                        $command = $command ? $command . " $line" : $line;
                }
                else
                {
                        $command = $command ? $command . " $line" : $line; #get the command
                        $term->addhistory($command) if (length($command) > 0);  # add to history
                        return $command;
                }
        }
}

sub main()
{
        my $perlcommand = undef;
        my $command;
        while ( defined ($command = &getline) )
        {
                if ($perlcommand)
                {
                        &executePerl($command);
                }
                else
                {
                        &executeSystem($command);
                }
        }
        &quit();   #  we're done now so quit
}

# Start:
&init();
&main();