root/examples/shell.pl

Revision 12311, 2.9 kB (checked in by audreyt, 2 years ago)

* all IRC-related programs in examples were using "\001", and so

were all broken by TimToady?++'s decree. Changed them to \x01.

Line 
1use v6-alpha;
2
3# A simple shell written in Perl6
4
5# TODO
6# BACKPSACE, history, editing ?
7
8
9my $prompt = '<p6shell>$ ';
10my $VERSION = '0.01';
11
12# we should have this list from some internal command
13# probably along with the signature of these functions
14my @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
21my $BSD_STYLE = 1;
22
23if ($BSD_STYLE) {
24    system "stty cbreak </dev/tty >/dev/tty 2>&1";
25}
26else {
27    system "stty", '-icanon', 'eol', "\x01";
28}
29
30my $_loop_ = get_loop();
31eval $_loop_;
32
33if ($BSD_STYLE) {
34    system "stty -cbreak </dev/tty >/dev/tty 2>&1";
35}
36else {
37    system "stty", 'icanon', 'eol', '^@'; # ASCII null
38}
39exit;
40
41#################################################333
42
43sub get_loop {
44return '
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....
79sub 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
105sub refresh_commandline {
106    my ($command) = @_;
107    print "\r", $prompt;
108    print " " x $command.bytes + 1;
109    print "\r", $prompt;
110    print $command;
111}
Note: See TracBrowser for help on using the browser.