examples/shell.pl

   1 use v6;
   2
   3 # A simple shell written in Perl6
   4
   5 # TODO
   6 # BACKPSACE, history, editing ?
   7
   8
   9 my $prompt = '<p6shell>$ ';
  10 my $VERSION = '0.01';
  11
  12 # we should have this list from some internal command
  13 # probably along with the signature of these functions
  14 my @available_commands = <exit print say>;
  15 @available_commands.push( <mkdir rmdir chdir unlink chmod chown> );
  16 @available_commands.push( <pop push> );
  17
  18
  19 # Enable reading character as they ar typed, see Perl5: perldoc -f getc
  20 # It would be better to use Term::ReadKey but it has to be implemented for Perl6
  21 my $BSD_STYLE = 1;
  22
  23 if ($BSD_STYLE) {
  24     run "stty cbreak </dev/tty >/dev/tty 2>&1";
  25 }
  26 else {
  27     run "stty", '-icanon', 'eol', "\x01";
  28 }
  29
  30 my $_loop_ = get_loop();
  31 eval $_loop_;
  32
  33 if ($BSD_STYLE) {
  34     run "stty -cbreak </dev/tty >/dev/tty 2>&1";
  35 }
  36 else {
  37     run "stty", 'icanon', 'eol', '^@'; # ASCII null
  38 }
  39 exit;
  40
  41 #################################################333
  42
  43 sub get_loop {
  44 return '
  45     loop {
  46         my $command = "";
  47         print "\n", $prompt;
  48         loop {
  49             my $char = $*IN.getc;
  50             if ($char eq "\n") {
  51                 # TODO: maybe check if _loop_ shows up in the input and disallow that code ?
  52                 if (eval "$command;" ~ $_loop_ ) {
  53                     exit;
  54                 }
  55                 else {
  56                     print $!;
  57                     last;
  58                 }
  59             }
  60             if ($char eq "\t") {
  61                 # clean the TAB but keep what we had so far
  62                 refresh_commandline($command);
  63
  64                 my $tail = tab_completition($command);
  65
  66                 if (defined $tail) {
  67                     $command ~= $tail;
  68                     refresh_commandline($command);
  69                 }
  70                 next;
  71             }
  72             $command ~= $char;
  73         }
  74     }
  75 ';
  76 }
  77
  78 # TODO: this should understand the command line typed in so far....
  79 sub tab_completition {
  80     my ($command) = @_;
  81
  82     my @possible_commands = grep { not index($_, $command)}, @available_commands;
  83     # TODO: might really get more than one... and we should let the user step through them using TAB
  84     # or display all possible values, or the user should be able to configure the behivaior
  85     return if not @possible_commands;
  86     return substr(@possible_commands[0], $command.bytes) if 1 == @possible_commands;
  87
  88     # TODO: if there are too many (> $LIMIT) ask if the user really wants to display all
  89     my $WIDTH = 80;
  90     my $out = '';
  91     my $line = '';
  92     for @possible_commands -> $com {
  93         if ($line.bytes + 1 + $com.bytes <= $WIDTH) {
  94             $line ~= " $com";
  95         } else {
  96             $out ~= "$line\n";
  97             $line = $com;
  98         }
  99     }
 100     $out ~= "$line\n";
 101     print "\n$out";
 102     return "";
 103 }
 104
 105 sub refresh_commandline {
 106     my ($command) = @_;
 107     print "\r", $prompt;
 108     print " " x $command.bytes + 1;
 109     print "\r", $prompt;
 110     print $command;
 111 }
 112