blob: d9a8489956cd479b1a8a8ba6f9ff0ee41583cab9 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
#!/usr/bin/env perl
use strict;
use warnings;
use Language::TECO;
use Term::ReadKey;
ReadMode 4;
END { ReadMode 0 }
my $te = Language::TECO->new;
sub command_as_string {
my $command = shift;
$command =~ s{([[:cntrl:]])}{
$1 eq "\n" ? "\n" : "^" . chr(ord('A') + ord($1) - 1)
}e;
return $command;
}
my $command = '';
COMMAND: while (1) {
print '*';
KEY: while (1) {
my $c = ReadKey 0;
last KEY unless defined $c;
my $pc = substr($command, -1);
if ($c eq "\e") {
print '$';
if ($pc eq "\e") {
print "\n";
ReadMode 3;
local $SIG{INT} = sub { die "Execution interrupted" };
eval { $te->execute($command) };
print "? $@\n" if $@;
ReadMode 4;
last KEY;
}
}
elsif ($c eq "\cc") {
last COMMAND;
}
elsif ($c eq chr(127)) {
print "\ch \ch" if $pc ne '';
substr($command, -1, 1) = '';
next KEY;
}
elsif ($c eq "\cu") {
my $new_command = $command;
$new_command =~ s/.*$//;
print "\ch \ch" x (length($command) - length($new_command));
$command = $new_command;
next KEY;
}
elsif ($c eq "\cg" && $pc eq "\cg") {
print "\n";
last KEY;
}
elsif ($c eq '*' && $pc eq "\cg") {
substr($command, -1, 1) = '';
print "\n*", command_as_string $command;
next KEY;
}
elsif ($c eq ' ' && $pc eq "\cg") {
substr($command, -1, 1) = '';
print "\n";
$command =~ /(.*)$/;
my $last_line = $1;
print '*' if $last_line eq $command;
print command_as_string $last_line;
next KEY;
}
elsif ($c eq '?' && $pc eq '') {
print "\ntodo...\n";
}
elsif ($c =~ /[[:alnum:]]/ && $command eq '*') {
print "\ntodo...\n";
}
else {
print command_as_string($c);
}
$command .= $c;
}
$command = '';
}
|
