| 1 | use v6-alpha; |
|---|
| 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 | system "stty cbreak </dev/tty >/dev/tty 2>&1"; |
|---|
| 25 | } |
|---|
| 26 | else { |
|---|
| 27 | system "stty", '-icanon', 'eol', "\x01"; |
|---|
| 28 | } |
|---|
| 29 | |
|---|
| 30 | my $_loop_ = get_loop(); |
|---|
| 31 | eval $_loop_; |
|---|
| 32 | |
|---|
| 33 | if ($BSD_STYLE) { |
|---|
| 34 | system "stty -cbreak </dev/tty >/dev/tty 2>&1"; |
|---|
| 35 | } |
|---|
| 36 | else { |
|---|
| 37 | system "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 | } |
|---|